Excel run time error '75' Path/file access error

[MajorFudge69]

Hi Guys, i'm very new to excel VBA and i'm having troubles to resolve this error. Everthing is working but i can't move the file from one path to the other

Excel run time error '75' Path/file access error​

Sub Import_All()

Dim fPath  As String, fName As String, fPathDone As String
Dim LR As Long, NR As Long
Dim LC As Long
Dim wbData As Workbook, wsMaster As Worksheet
Dim StartCell As Range
Dim wsData As Worksheets
Dim LRMaster As Long
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

'Setup

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wsMaster = ThisWorkbook.Sheets("OR MANAGEMENT - INPUT")
    
    With wsMaster
   
   LR = wsMaster.Cells.Find(What:="*", After:=wsMaster.Range("E10"), LookIn:=xlFormulas, _
           Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
           MatchCase:=False).Row

   LC = wsMaster.Cells.Find(What:="*", After:=wsMaster.Range("E10"), LookIn:=xlFormulas, _
           Lookat:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
           MatchCase:=False).Column

   Set GetLastNonEmptyCellOnWorkSheet = wsMaster.Cells(LR, LC)
   
'Pasta
Do
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = DefaultFolder
        .Title = " Selecione a Pasta com os ficheiros a importar | MOAI Consulting"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            fPath = .SelectedItems(1) & "\"
        Exit Do
        Else
            If MsgBox("Não foi selecionado nenhum ficheiro, deseja cancelar?", _
                vbYesNo) = vbYes Then Exit Sub
        End If
    End With
    
 Loop
 
fPathDone = fPath & "Imported"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xlsx*")       'listing of desired files, edit filter as desired

'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName) 'Open file
               
  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wbData.Worksheets("Sheet1").Cells(wbData.Worksheets("Sheet1").Rows.Count, "B").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsMaster.Cells(wsMaster.Rows.Count, "E").End(xlUp).Offset(1).Row

  '3. Copy & Paste Data
  wbData.Worksheets("Sheet1").Range("B3:J" & lCopyLastRow).Copy
    wsMaster.Range("E10").PasteSpecial
    
Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
        End If
        fName = Dir                                       'ready next filename
    Loop
End With

ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

 

[KOKOSEK]

You've got comments about final \ and as I see there is not there

fPathDone = fPath & "Imported"     'remember final \ in this string

I think it should be:

fPathDone = fPath & "Imported\"     'remember final \ in this string

Just guessing, you did not say which line generates error.