Help required in VBA

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,
Could u please give a solution for the following query.

I receive around 10 XLS files everyday. I want a macro which will do the
following:

In every file opened a marco must look for the name of a City in the Cell
D9 and then save the workbook in the already existing subfolder which has the
same name as the city.

For Example

There are the following subfolders existing:
Washington, Caliornia, New Jersey, Pilphedia,

if D9 has "California" the macro must save the file in folder "California".

Eagerly waiting for a reply and Thankyou in Advance.

Regards,

MADHU
 
Just do a saveas

ACtiveworkbook.SaveAs Filename:= "C:\" & activesheet.range("D9").value &
"\" & activeworkbook.name

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
You need to put the below code in "Personal.xls".
If you don't know how to create personal.xls then:
In excel click on menu Tools->Macros->Record a New Macro.
Record New Macro box will appear. In this box, under 'Store Macro In:'
Select 'Personal Macro Workbook' and click on OK.
Then on the Macro Record tool bar click on Stop Recording.

Click on menu Windows ->Unhide. In the window that will pop up
select Personal.xls and click on OK.
Start visual basic editor.
You will find a Module1 in personal.xls moudules list
and you will also find the recorded macro.
Delete that macro and in it's place copy and paste below macro.

Sub CityFolSave()
Dim sPath1 As String, sPath2 As String, wbName As String
Dim fs
sPath1 = "C:\Excel Files" 'here enter your main path of the city folder
'without the city name. Don't forget a "\" at the end!
wbName = ActiveWorkbook.Name
If InStr(1, wbName, ".xls") = 0 Then wbName = wbName & ".xls"
sPath2 = Trim(ActiveSheet.Range("D9").Value)
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(sPath1 & sPath2) Then
MsgBox "Folder '" & sPath1 & sPath2 & "' does not exist." _
& Chr(13) & "Can't save. Please create the folder first"
Exit Sub
End If
If fs.Fileexists(sPath1 & sPath2 & "\" & wbName) Then
wbName = InputBox("File " & wbName & "already exists in folder '" _
& sPath2 & "'. Please enter a different name to save w/o path", ,
wbName)
If Len(wbName) = 0 Then Exit Sub 'user cancled
If InStr(1, wbName, ".xls") = 0 Then wbName = wbName & ".xls"
End If
ActiveWorkbook.SaveAs sPath1 & sPath2 & "\" & wbName
End Sub

Note: In above macro I set sPath1 = "C:\Excel Files\" just for example.
You need to set it to the correct main path, in which subfolders with
city name are there. (e.g. "C:\" if in directly in C:). dont forget to put
"\" at the end.

Save personal.xls, then "unhide it". Close excel, it will again prompt for
saving personal.xls, click on Yes.

Start excel again.
Open one of your excel files you want to save in city folder.
Select the sheet in which "D9" has city name.
Then click on Tools->Macros->Macros.
Select Personal.xls!CityFolSave and click on run.

Sharad
 
Just a learner getting it all clear in my head so no
disrepect intended....
Sharad should the personal.xls file then be saved or
placed into the Excel startup file so it automatically
opens with Excel and set as hidden ...... or isn't this
recommended anymore???
Only gained insight to personal.xls file yesterday from
MVP sites, so if this has changed please advise.

Many thanks..............Kev.
 
The personal file, thus created (as I told), should be just saved (not save
as) and it will automatically get saved in the correct xlStart folder.
Yes, next time you start execel it will automatically open. (This is
required.)
If it opens un-hidden, it means you did not hide it before saving last time.
so if it opens un-hidden, hide it. Quit excel, it will ask to save changes
to personal.xls
click on Yes. Start excel again, it will then open hidden.

Sharad
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top