Open several files and copy the contents

[Jim G]

I have a template that requires new data from 4 files. I want to open each
in turn and copy the contents into specified sheets in the template. Each
file is created by another program that always uses the same file name. The
users add an extension to the name for each company they are working on to
keep htem unique.

I have the following code that opens the first file and copies the new data
okay. Is there a way to modify this to use the one user input for each file
and copy the data in turn to each worksheet?

Sub OpenFile()

Dim myFileName As Variant
Dim wkbk As Workbook
Dim MyPath As String
Dim sFilename As String
Dim fExitDo As Boolean
Dim sFileType As String
Dim sFileOpen As String
Dim sFileBudget As String
Dim sFileJobList As String
Dim sFileOrders As String
Dim sFileLedger As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Select ""YES"" to proceed to Open WIP Data Files, ""NO"" to view
Current File only"
Style = vbYesNoCancel + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Open New WIP Data Files " ' Define title.

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

sFileBudget = "jobba1-" '--Job budget file to copy to sheet "Budget"
sFileJobList = "jobbl1-" '--Job Job List file to copy to sheet WIP"
sFileOrders = "salcustd1-" '--Job Customer Sales Orders file to copy to
sheet "Orders"
sFileLedger = "genjrld1-" '--Job General Ledger Detail file to copy to
sheet "Ledger4900"

MyPath = "S:\MYOB Data Files\WIPData\"
ChDrive "S:\"
ChDir MyPath

'--users are to add a file name extension to the standard reports and save
as .XLS files. It will be same for all 4 data files
sFilename = InputBox("Please Provide ONLY the Name you saved the file as.
EG: DEMO")

FilesInPath = Dir(MyPath & "*.xl*") 'Check to see if files exist (Ron
DeBruin)
If sFilename = "" Then
Exit Sub 'user hit cancel
If FilesInPath = "" Then
MsgBox "No files found-make sure you have saved your
files in the correct location"
Exit Sub
End If
End If

sFileOpen = MyPath & sFileBudget & sFilename & ".xls"
fExitDo = False


Set wkbk = Workbooks.Open(Filename:=sFileOpen)

Else
Exit Sub
End If

ActiveSheet.Cells.Select
Selection.Copy
Application.DisplayAlerts = False
Windows("WIP Template V1.xls").Activate
Sheets("Budget").Select
Cells.Select
ActiveSheet.Paste

wkbk.Close Savechanges = False

Application.DisplayAlerts = True

End Sub

 

[Joel]

I used a picker box to select the directory then open, copied, and closed
each of the 4 workbooks


Sub OpenFile()

Dim myFileName As Variant
Dim wkbk As Workbook
Dim MyPath As String
Dim sFilename As String
Dim fExitDo As Boolean
Dim sFileType As String
Dim sFileOpen As String
Dim sFileBudget As String
Dim sFileJobList As String
Dim sFileOrders As String
Dim sFileLedger As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Msg = "Select ""YES"" to proceed to Open WIP Data Files, " & _
"""NO"" to view Current File only"
Style = vbYesNoCancel + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Open New WIP Data Files " ' Define title.

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

sFileBudget = "jobba1-" '--Job budget file to copy to sheet "Budget"
sFileJobList = "jobbl1-" '--Job Job List file to copy to sheet WIP"
sFileOrders = "salcustd1-" '--Job Customer Sales Orders file to copy to
'Sheet "Orders"
sFileLedger = "genjrld1-" '--Job General Ledger Detail file to copy to
'Sheet "Ledger4900"

MyPath = "S:\MYOB Data Files\WIPData\"
ChDrive "S:\"
' ChDir MyPath

'--users are to add a file name extension to the standard reports and
save
'as .XLS files. It will be same for all 4 data files

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select Folder"

If .Show <> -1 Then
MsgBox "No files found-make sure you have saved your" & _
"files in the correct location"
Exit Sub
End If

Application.DisplayAlerts = False

sFileOpen = .InitialFileName & sFileBudget & ".xls"
If Dir(sFileOpen) = "" Then
MsgBox ("Cannot find file : " & sFileOpen)
Else
Set wkbk = Workbooks.Open(Filename:=sFileOpen)


ActiveSheet.Cells.Copy _
Destination:=Workbooks("WIP Template V1.xls"). _
Sheets("Budget").Cells

wkbk.Close Savechanges = False
End If

sFileOpen = .InitialFileName & sFileJobList & ".xls"
If Dir(sFileOpen) = "" Then
MsgBox ("Cannot find file : " & sFGileOpen)
Else
Set wkbk = Workbooks.Open(Filename:=sFileOpen)

ActiveSheet.Cells.Copy _
Destination:=Workbooks("WIP Template V1.xls"). _
Sheets("WIP").Cells

wkbk.Close Savechanges = False
End If

sFileOpen = .InitialFileName & sFileOrders & ".xls"
If Dir(sFileOpen) = "" Then
MsgBox ("Cannot find file : " & sFileOpen)
Else
Set wkbk = Workbooks.Open(Filename:=sFileOpen)

ActiveSheet.Cells.Copy _
Destination:=Workbooks("WIP Template V1.xls"). _
Sheets("Orders").Cells

wkbk.Close Savechanges = False
End If

sFileOpen = .InitialFileName & sFileLedger & ".xls"
If Dir(sFileOpen) = "" Then
MsgBox ("Cannot find file : " & sFileOpen)
Else
Set wkbk = Workbooks.Open(Filename:=sFileOpen)

ActiveSheet.Cells.Copy _
Destination:=Workbooks("WIP Template V1.xls"). _
Sheets("Ledger4900").Cells

wkbk.Close Savechanges = False
End If

End With

Application.DisplayAlerts = True

Else
Exit Sub
End If


End Sub

 

[Jim G]

Thanks again Joel,

I've put "sFilename = InputBox("Please Provide ONLY the Name you saved the
file as. EG: DEMO")" back in due to the fact that there is liekly to be more
than one company's files at a time.

The dialogue picker will only select the subdirectory below the one I select
(select or double click into)

Debug.Print (sFileOpen) returns, S:\MYOB Data Files\jobba1-demo.xls when I
expected, S:\MYOB Data Files\WIPDaa\jobba1-demo.xls

Could we fix the directory location or set the dialogue picker to default
there?

Cheers
Jim

 

[Jim G]

As an interim measure I added:

WIPpath = "\WIPData\"
and
sFileOpen = .InitialFileName & WIPPath & sFileBudget & sFilename & ".xls"

This works fine. I would still like to know what the problem was with the
first solution.

 

[Joel]

When I was testing the code I commented out the following line. I forgot to
uncomment the code before I posted the results

' ChDir MyPath

This will get you to your initial directory. The directory picker will
allow you to move up directories if you use the drop drop down box at the top
of the pop up, or you can use the up arrow to move up a directory.

 

[Jim G]

Thanks Joel, all is working well now.

You guys make me look good, I'm most grateful for the expertise.