Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Open several files and copy the contents
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 132
Default Open several files and copy the contents
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




--
Jim
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Open several files and copy the contents
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" wrote:

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




--
Jim
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 132
Default Open several files and copy the contents
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


"Joel" wrote:

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" wrote:

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




--
Jim
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 132
Default Open several files and copy the contents
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.
--
Jim


"Joel" wrote:

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" wrote:

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




--
Jim
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Open several files and copy the contents
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" wrote:

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.
--
Jim


"Joel" wrote:

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" wrote:

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




--
Jim
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 132
Default Open several files and copy the contents
Thanks Joel, all is working well now.

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


"Joel" wrote:

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" wrote:

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.
--
Jim


"Joel" wrote:

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" wrote:

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




--
Jim
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA - Insert row, copy contents of original row except for contents of columns A-N Royzer Excel Programming 4 February 21st 12 08:04 PM
VBA - Insert row, copy contents of original row except for contents of column A Royzer Excel Programming 4 February 21st 12 02:47 PM
Open multiple text files and paste contents to single cell [email protected] Excel Programming 1 October 19th 05 04:05 PM
From excel - open word doc and copy form field contents to excel c gnome88 Excel Programming 0 July 25th 05 11:45 PM
open some txt files ,find text , copy the text before that to a single cell gus Excel Programming 2 July 11th 05 05:40 PM


All times are GMT +1. The time now is 01:50 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement