PDA

View Full Version : loop not working for next file in same folder



rrosa1
05-11-2015, 02:36 PM
i have this module in 1 xlsm file in diff folder and i try to print other folder file but first file work perfect but it do not detect second file and goes in loop can any one help me please
any help is appreciated.


Sub aaaCombineFiles() ''' working 1

Dim Path As String, mypath
Dim FileName As String, fname, ndir
Dim Wkb As Workbook, myfile
Dim WS As Worksheet

'Optimize Macro Speed
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With


'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
'Set fdl = Application.FileDialog(msoFileDialogFilePicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
'FileName = .SelectedItems(1)
Path = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
Path = Path
If Path = "" Then GoTo ResetSettings


'Path = "D:\pdf records\" 'Change as needed
FileName = Dir(Path & "\*.xlsx", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

On Error Resume Next
Wkb.Worksheets("Month Total").Delete
Wkb.Worksheets("Rev Report").Delete


For Each WS In Wkb.Worksheets
'WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Dim dlater As String, getwbn
getwbn = FileName
dlater = Left(getwbn, 9)
fname = dlater
ndir = "D:\1\" & fname & "\"
If Dir(ndir, vbDirectory) = "" Then MkDir ndir
myfile = Dir(mypath & "Rev*" & myExtension)
strPDFName = WS.Name
strdir = ndir
fileSaveName = ndir & WS.Name
WS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fileSaveName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False ', PageSetup.Orientation = xlLandscape
Next WS
Wkb.Close False
' ChDir Path 'strdir
FileName = Dir()
Loop

ResetSettings:
'Reset Macro Optimization Settings
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
.CutCopyMode = False
End With

End Sub

rrosa1
05-12-2015, 06:55 AM
hi i try to alter with this code from KB entry of Apps http://www.vbaexpress.com/kb/getarticle.php?kb_id=1042 and change the code for i need it work for the 1 file then code stuck in the 1st workbook and not closing the 1 st wb and opening next workbook as i needed any guidance is appreciated thanks.

rrosa1
05-12-2015, 06:57 AM
macro stuck hear any way to stop once all sheets printed then came out of this code and do next task ?

rrosa1
05-12-2015, 07:16 AM
geting run time error '5" invalid procedure call or argument
and showing this yellow

what im doing wrong pl help me