im trying to combine the excel files in the sharepoint folder by using vba, but it seems the path does not working and run time error: 52
keep on coming out due to error in the highlighted code.
Here is the code:
Option Explicit
Sub ConsolidateAllDepartment()
Dim wb As Workbook
Dim wsCopy As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim mylCol As Long
Dim Row1 As Long
Dim FileNum As Integer
Dim ActWb As Workbook
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Open workbook
Dim nwb As Workbook
Dim nsh As Worksheet
'Open workbook
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
'Set ActWb = ActiveWorkbook
Set wsCopy = Workbooks("Template for incident closure.xlsm").Sheets("Master Listing (ALL)")
'Copy Table Header
wsCopy.Range("A1:AD1").Copy nsh.Range("A1")
Set nwb = ActiveWorkbook
Dim mylRow As Long
'find last row after clear data
mylRow = Cells(Rows.Count, 1).End(xlUp).Row
'setting input path
myPath = "https:\\workspace.maybank.com.my\sites\Etiqa-Risk\OSRM\ORO\Incident%20Pending%20Closure\by%20Entity-Department\"
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsx"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'ChDir myPath
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'find last row and last col in wb
wb.Activate
Row1 = Cells(Rows.Count, "A").End(xlUp).Row
'copy the range from A2 to last cell
Range("A2:AD" & Row1).Copy
'paste to main file
nwb.Activate
Range("A" & mylRow + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
mylRow = mylRow + Row1 - 1
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Columns("A").Delete
nwb.SaveAs "https://workspace.maybank.com.my/sites/Etiqa-Risk/OSRM/ORM/Incident%20Pending%20Closure/Consolidated%20Files/Consolidated" & Format(Now(), "ddmmyyyy") & ".xlsx"
nwb.Close False
MsgBox "Done"
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last column
'OUTPUT : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function