Macro to create a folder and copy files

[GainesvilleWes]

Hello,
Any help would be greatly appreciated:
I am attempting to write a macro to do the following once a specific .xls
file is opened:
1) Prompt the user to enter a folder name
2) Close that .xls file
3) Create a folder with the user entered name in a specific location
4) Copy the .xls file into the folder
5) Copy three (3) other .doc files to that folder
6) Open the copied .xls file

As I said, any assistance would be greatly appreciated.
Thank you,
Wes

 

[Bob Phillips]

Sub DoStuff()
Dim sDir As String
Dim aryDirs
Dim i As Long
Dim tmp As String
sDir = InputBox("Supply folder name")
aryDirs = Split(sDir, "\")
tmp = aryDirs(LBound(aryDirs))
For i = LBound(aryDirs) + 1 To UBound(aryDirs)
tmp = tmp & "\" & aryDirs(i)
On Error Resume Next
MkDir tmp
On Error GoTo 0
Next i
ThisWorkbook.SaveCopyAs tmp & "\" & ThisWorkbook.Name
FileCopy "C:\Test\File 1.xls", tmp & "\" & "File 1.xls"
FileCopy "C:\Test\File 2.xls", tmp & "\" & "File 2.xls"
FileCopy "C:\Test\File 3.xls", tmp & "\" & "File 3.xls"
End Sub




--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[GainesvilleWes]

Bob,
You sir are a king among men.
Many, many, many thanks.

Sub DoStuff()
Dim sDir As String
Dim aryDirs
Dim i As Long
Dim tmp As String
sDir = InputBox("Supply folder name")
aryDirs = Split(sDir, "\")
tmp = aryDirs(LBound(aryDirs))
For i = LBound(aryDirs) + 1 To UBound(aryDirs)
tmp = tmp & "\" & aryDirs(i)
On Error Resume Next
MkDir tmp
On Error GoTo 0
Next i
ThisWorkbook.SaveCopyAs tmp & "\" & ThisWorkbook.Name
FileCopy "C:\Test\File 1.xls", tmp & "\" & "File 1.xls"
FileCopy "C:\Test\File 2.xls", tmp & "\" & "File 2.xls"
FileCopy "C:\Test\File 3.xls", tmp & "\" & "File 3.xls"
End Sub

Hello,
Any help would be greatly appreciated:

[quoted text clipped - 10 lines]

Thank you,
Wes