0

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
James Z
  • 12,209
  • 10
  • 24
  • 44
  • 1
    https://stackoverflow.com/questions/67619512/direxist-for-onedrive-synchronized-sharepoint-directories/67621095#67621095 – Kostas K. Jun 15 '21 at 10:07
  • You cannot run `Dir()` on a HTTP path. Maybe try the `SharePointURLtoUNC` function from this post: https://stackoverflow.com/questions/1344910/get-the-content-of-a-sharepoint-folder-with-excel-vba – Tim Williams Jun 15 '21 at 16:12

0 Answers0