PDA

View Full Version : [SOLVED] VBA help please



leemcder
03-12-2018, 03:48 AM
Hi, I use a macro in excel, so I list file names and it prints out the .XLS documents I have listed in row A. (copy of the script below) I now want to print a specific document between each file I have listed. The document will always be the same, I want it to print the document is A1,A2,A3 etc but print a second sheet between each of these (this will always be the same document) can someone please tell me how I do this without having to manually input the path between A1,A2,A3 etc? Many thanks

Sub PrintFiles()
Dim oFSO As Object
Dim lngLastRow As Long
Dim lngIndex As Long
Dim strFname As String
Dim xlSheet As Worksheet
Dim xlWB As Workbook
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set xlSheet = ActiveSheet
With xlSheet
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lngIndex = 1 To lngLastRow
strFname = .Range("A" & lngIndex)
If oFSO.FileExists(strFname) Then
'If oFSO.FileExists("C:\Path" & strFname) Then
'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
Set xlWB = Workbooks.Open(strFname)
'Set xlWB = Workbooks.Open("C:\Path" & strFname)
'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
xlWB.Sheets(1).PageSetup.Zoom = 95
xlWB.Sheets(1).PrintOut From:=1, To:=1
xlWB.Close savechanges:=False
Else
.Range("A" & lngIndex).Interior.Color = &H80FFFF
End If
Next lngIndex
End With
lbl_Exit:
Set oFSO = Nothing
Set xlSheet = Nothing
Set xlWB = Nothing
Exit Sub
End Sub

georgiboy
03-12-2018, 04:44 AM
Hi there

Your title really needs to be more constructive, nearly everyone comes here for VBA help.
You might want to use code tags also, you can get these from clicking on the # symbol in the text editor.

If your code works well the maybe all you need to do is to add a line to print a sheet from the workbook from which the code is running from.

For example:

Sub PrintFiles()

Dim oFSO As Object
Dim lngLastRow As Long
Dim lngIndex As Long
Dim strFname As String
Dim xlSheet As Worksheet
Dim xlWB As Workbook

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set xlSheet = ActiveSheet

With xlSheet
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lngIndex = 1 To lngLastRow
strFname = .Range("A" & lngIndex)
If oFSO.FileExists(strFname) Then
'If oFSO.FileExists("C:\Path" & strFname) Then
'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
Set xlWB = Workbooks.Open(strFname)
'Set xlWB = Workbooks.Open("C:\Path" & strFname)
'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
xlWB.Sheets(1).PageSetup.Zoom = 95
xlWB.Sheets(1).PrintOut From:=1, To:=1
ThisWorkbook.Sheets(1).PrintOut From:=1, To:=1
xlWB.Close savechanges:=False
Else
.Range("A" & lngIndex).Interior.Color = &H80FFFF
End If
Next lngIndex
End With
lbl_Exit:
Set oFSO = Nothing
Set xlSheet = Nothing
Set xlWB = Nothing
Exit Sub

End Sub

Untested

leemcder
03-12-2018, 05:11 AM
Thank you, this works perfectly!