Microsoft Access 掲示板

VBAでインポート処理ができたエクセルファイルのみ別フォルダへ移動したい / 19

21 コメント
views
4 フォロー
19
初心者 2023/01/14 (土) 12:30:59 ddef7@7bb1a

hirotonさんありがとうございます。
今回はエラーで止めるより、止めずにインポートできるものだけインポートしてインポートできなかったものは元のフォルダに戻り、インポートできなかったファイル名とエラーも出力されるので、後からわかるので、いいような気がします。
ただ、エラー処理についてほとんど考えたことがなかったので、もう一度コードを見直してみます。

もう一つ教えていただきたいことがあるのですが、質問の内容と外れているので、別の質問であげたほうがいいのかもしれませんが。
今回想定しているエクセルは、1つのファイルにレコードは一つ、フィールドは複数という想定です。
できれば列(横)方向にフィールド名、行(縦)方向にレコードになるようにしようと思っていますが、元々申請書類をそのままエクセルで印刷できるようになっているため、テーブルに保存したいデータがいろんなセルにある場合に、複数のセルを指定してインポートすることは可能でしょうか?
保存テーブルのフィールド名をf1,f2,f3,f4,f5というように作成しておいて、読み込むエクセルのセルの場所をを順番にA2,E2,A5,E5(f5にはファイル名)というように指定していこうと思っています。
一つのセルなら指定できましたが、複数となると、うまくいかないのですが、可能でしょうか?
決まった様式なので、セルの座標は固定、シートも同じなのですが、場所が点在している状態です。元のエクセルで数式を使って格子状に配列すれば良いのですが、後からの修正が困難なので、今後追加で保存したい項目が出てきたときになかなかできなくなってしまうので、アクセス側で変更できれば便利だと思い質問させていただいています。どうぞよろしくお願いします。

    Dim dname As String
    Dim tblname As String
    Dim sname As String
    Dim destinationFolder As String
    dname = "C:\アクセス\エクセル\"
    tblname = "T2"
    sname = "sheet4!a2:a2"
    destinationFolder = "C:\アクセス\エクセル\処理済\"

    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 '拡張子がxlsxのファイル
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, f.Path, False, sname
            If Err.Number = 0 Then               'エラーなくインポートされた
                CurrentDb.Execute "UPDATE T2 SET f5 = '" & f.Name & "'" & _
                              " WHERE f5 Is Null;", dbFailOnError
                fso.MoveFile f.Path, destinationFolder 'ファイル移動
            End If
            If Err.Number <> 0 Then 'エラー発生
                'とりあえずイミディエイトにファイル名、エラーメッセージを出力
            Debug.Print f.Name & " " & Err.Number & ":" & Err.Description
                CurrentDb.Execute "insert into T3(ファイル名,エラー番号,エラー内容) VALUES('" & f.Name & "','" & Err.Number & _
                                "',""'" & Err.Description & "'"");", dbFailOnError
            
            Err.Clear
            End If
        End If
                    
    Next
    On Error GoTo 0 'エラー処理を無効にする

    Set fso = Nothing

この中で

    sname = "sheet4!a2:a2"

をいろいろ書き方を変えてみたのですが、ダメでした。
どうぞよろしくお願いします。

通報 ...