loop not working for next file in same folder
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.
Code:
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
