Microsoft Access 掲示板

とりあえずのエラー処理を追加したサンプルコード

Public Sub Sample()
    Dim dname As String
    Dim tblname As String
    Dim sname As String
    Dim destinationFolder As String
    dname = "C:\Test\Import\"
    tblname = "Sheet1"
    sname = "sheet1!"
    destinationFolder = "C:\Test\Import\処理済\"

    Dim fso As New Scripting.FileSystemObject
    Dim fl As Folder
    Set fl = fso.GetFolder(dname)                ' フォルダを取得
    
    On Error Resume Next 'エラーが発生した場合無視して次の行へ
    Dim f As File
    For Each f In fl.Files                       ' フォルダ内のファイルを取得
        If fso.GetExtensionName(f.Path) = "xlsx" Then
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, f.Path, True, sname
            If Err.Number = 0 Then               'エラーなくインポートされた
                CurrentDb.Execute "UPDATE Sheet1 SET ファイル名 = '" & f.Name & "'" & _
                                  " WHERE ファイル名 Is Null;", dbFailOnError
                fso.MoveFile f.Path, destinationFolder
            End If
            If Err.Number <> 0 Then 'エラー発生
                'とりあえずイミディエイトにファイル名、エラーメッセージを出力
                Debug.Print f.Name & " " & Err.Number & ":" & Err.Description
                Err.Clear
            End If
            
        End If
    Next
    On Error GoTo 0 'エラー処理を無効にする

    Set fso = Nothing

End Sub