MS Access

Accessでファイル選択ダイアログを開いて選択したExcelファイルの先頭シートを読み込み番号が一致するデータの配送日を本日日付で消し込む処理

投稿日:2018年8月13日 更新日:

ファイル選択ダイアログを開いて、選択したExcelファイルの先頭シートを読み込み、番号が一致するデータの配送日を本日日付で消し込む処理(楽天販売DB.mdb)

ダイアログを表示する際には、事前にMicrosoft Office x.x bject Libraryに参照設定しておく。
ダイアログ表示と、Excelの先頭シート名を取得するときに、苦労。

参考リンク:
必要な列と行だけEXCELからインポートしたい –Access Club 超初心者 FORUM–

Private Sub cmd楽天伝票消込_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fi As Long, foi As Long, fno As String
    Dim wsName As String
    Dim intRet As Integer         'ダイアログ用変数
    Dim ImPass As String     'フルパスの値
 
    With Application.FileDialog(msoFileDialogOpen)
        'ダイアログのタイトルを設定
        .Title = "ファイルを開くダイアログ"
        .Filters.Clear
        .Filters.Add "Microsoft Office Excelファイル", "*.xls,*.csv"
        .FilterIndex = 1
        .AllowMultiSelect = False '複数ファイル選択を許可しない
        .InitialFileName = "\\FileServer\share\ '初期パスを設定
        intRet = .Show 'ダイアログを表示
        If intRet <> 0 Then
          ImPass = Trim(.SelectedItems.Item(1))
        Else
          ImPass = ""
          MsgBox "ファイルが選択されませんでした"
          Exit Sub
        End If
    End With
    
' *** Excelのシート名を取得する処理
' ms access - Read Excel file sheet names - Stack Overflow
' https://stackoverflow.com/questions/18412697/read-excel-file-sheet-names
    Dim objExc As Object ' late
    Dim objWbk As Object ' late
    Dim objWsh As Object ' late

    'Set objExc = New Excel.Application ' early
    Set objExc = CreateObject("Excel.Application") ' late
    Set objWbk = objExc.Workbooks.Open(ImPass)
    For Each objWsh In objWbk.Worksheets
        wsName = objWsh.Name
    Next
    Set objWsh = Nothing
    objWbk.Close
    Set objWbk = Nothing
    objExc.Quit
    Set objExc = Nothing
'***

Set dbs = Application.CurrentData
Set db = CurrentDb()
mySQL = "SELECT お客様管理番号 FROM [" & wsName & "$] IN '" & ImPass & "' 'Excel 8.0;';"
    Set rs = db.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    If rs.EOF = False Then rs.MoveLast
    ProgBarCnt = rs.RecordCount
    If rs.EOF = True Then
        MsgBox "楽天テーブルにデータはありませんでした"
        Exit Sub
    Else
        rs.MoveFirst
        Do Until rs.EOF
            strSQL = "SELECT ID FROM Zaiko楽天販売TBL WHERE 受注番号 = '" & rs!お客様管理番号 & "';"
            Set rst = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
            If rst.EOF Then
            Else
                CurrentDb.Execute "UPDATE zaiko楽天販売TBL SET 配送日 = #" & Date & "# WHERE [受注番号] = '" & rs!お客様管理番号 & "';"
                fi = fi + 1
            End If
            rst.Close
            rs.MoveNext
        Loop
    End If
    
    MsgBox "楽天" & fi & "件のレコードを更新しました。"

    rs.Close: Set rs = Nothing
    db.Close: Set db = Nothing
    
Exit_cmd楽天伝票消込_Click:
    Exit Sub

Err_cmd楽天伝票消込_Click:
    MsgBox Err.Description
End Sub

-MS Access

執筆者:

関連記事

no image

.htaccessと25番ポートブロック

初めてレンタルサーバの乗り換えにチャレンジした、昨日客先。 前日から今朝まで、新アドレスでの表示はずっと「500 Internal Server Error」。 乗り換え先レンタルサーバにサポート依頼 …

no image

Accessで1件ずつレコードを読んでスナップショットファイルを作ってメール送信する処理

作るのにWebに情報が無くてすごく苦労したので備忘録。 私にしかわからないかもしれないけど、見た人も何か参考になるかもしれないから、公開しよっと。 ■事前準備 1.処理を起動するフォームにボタン「調査 …

Accessで複数レコードを1レコードにまとめる(運送会社送り状作成のため

Accessに入れてある楽天の注文データをもとに、運送屋さんの送り状伝票を作ろうと思い立った。 しかし、楽天の注文データは、同一の受注番号で複数の商品に分かれている。 例えば一人の人が3点買い物をした …

no image

AccessのレポートでNoDataでイベントキャンセル後もReport_Closeが実行されて困った

Accessのレポートで表示するデータがない場合は、以下のように書けばスマートにキャンセルできる。 Private Sub Report_NoData(Cancel As Integer) MsgBo …

no image

ExcelブックをAccessで読みたいときにリンクテーブルを使わない方法があったとは・・・知らなかった

とある業務で、Access内でExcelブックをリンクテーブルで読む・・・という使い方をしてきた。 (AccessのmdbはNASにおいて共有している。Excelのxlsも同じく) これはこれで便利な …