Microsoft Access 掲示板

フォームからExcelファイルの一部分をインポートしたい

27 コメント
views

お世話になります。
以下のようなことがしたいです。

1.F_注文取込というフォームに配置したcmb_発注者というコンボボックスから発注者を選択すると選んだ発注者によってtxb_発注者というテキストボックスに、発注者の略称(アルファベット2~3文字)が表示される。

2.btn_発注書取込というコマンドボタンをクリックすると、ダイアログが開き、取り込みたい発注書の.xlsxファイルを選択する。(ブックの中身は発注書という名前のシート1枚のみ。H2セルに発注番号が入力されており、A11からH11まではフィールド名で、A1 №、B11 品番、C11 品名、D11 数量、E11 単価、F11 金額、G11 納期、H11 発注者備考。A12からH151までは注文内容を入力する部分になっている。A12セルに=IF(B12="",0,COUNTA(B12:B$12))という数式が入っており、B列が入力されると連番が表示されるようになっています。F12セルには=D12*E12という数式が入っており、数量×単価が計算されるようになっています。A列とF列はオートフィルで151行目まで式が入っています)

3.選択したファイルのレコード部分のみ(12行目からレコードの最終行まで)をT_注文取込という一時テーブルにインポートする。T_注文取込には、Excelファイルの11行目と同じフィールドと、プラスで注文番号というフィールドがあり、この注文番号フィールドに、F_注文取込のtxb_発注者の値+ExcelファイルH2セルの発注番号+Excelファイルの№フィールドの値を4桁にしてハイフンで繋いだ値を入れたい。例えば、txb_発注者がAA、受注番号が1111、№が1のレコードには、『AA-1111-0001』としたい。№が11なら『AA-1111-0011』といった感じです。

4.T_注文取込のレコードを、T_注文データに追加する。

5.取込み終わったExcelファイルのファイル名の先頭に、『取込済み_』と追加する。

名前なし
作成: 2025/07/10 (木) 15:42:37
最終更新: 2025/07/10 (木) 15:42:56
通報 ...
1
りんご 2025/07/10 (木) 21:37:12 935bc@0e907

発生者入力、受注番号入力はExcelで全部済ませればいいんですよ。

2
名前なし 2025/07/11 (金) 17:11:51 8e071@44ebd >> 1

荒らしの方は回答しないでください。

3
りんご 2025/07/11 (金) 17:34:15 935bc@0e907

 発注書のexcelファイルには、当然、発注者のセルがありますよね?セルの値に応じて別のセルに略称を表示するだけです。Accessの入力フォームは不要です。
 注文番号のハイフン結合はセル結合するだけでしょ。

4
名前なし 2025/07/14 (月) 08:56:53 8e071@44ebd >> 3

発注書のexcelファイルには、当然、発注者のセルがありますよね?セルの値に応じて別のセルに略称を表示するだけです。Accessの入力フォームは不要です。

→不要かどうかはあなたが決めることではありません。例えば同じ発注者(社名)であっても発注書の入力する人間によって『A株式会社』や『A 株式会社』など入力の仕方に差異がある場合が考えられます。

注文番号のハイフン結合はセル結合するだけでしょ。

→あなたが質問文を全く読まずに他人の質問にケチつけたいだけというのが大変よく分かるのですが、№の部分をそのままセル結合したら、4桁の数字になりませんよ。

ともかく、荒らしであるあなた(りんご)からのコメント・回答は求めておりませんので、今後このスレッドにコメントはしないでください。
別の回答者様がいらっしゃったら、回答をよろしくお願いいたします。

5
りんご 2025/07/14 (月) 19:11:06 935bc@0e907

発注書の入力する人間によって『A株式会社』や『A 株式会社』など入力の仕方に差異がある場合が考えられます。

 世の中のExcel発注書はそうならないように会社名など雛形になっているんですよ。

№の部分をそのままセル結合したら、4桁の数字になりませんよ。

 そりゃそうですよ。工夫してセル結合するだけでしょ。

うーん、Excelで出来ないことをAccessで出来るわけないんですよ。丸投げ質問は他の回答者でも難しいんじゃないかしら?

6
PPP 2025/07/14 (月) 21:00:32 修正 50473@7267b

とりあえず、コンボBOXの値をテキストボックスに反映するには
コンボBOXの.Column()で値を取得します。
.Column()のカッコのなかはゼロオリジンで指定しますので
コンボBOXの値の1列目を取得するばあいは.Column(0)
2つ目を取得する場合は.Column(1)とします。
またコンボBOXをテキストボックスに代入するのはいいのですが
テキストボックスなので値を間違って書き換えられるおそれがあります。

なので、ラベルに記載したほうが無難です。どうしてもテキストボックスに
転記、および値を書き換えられないようにするには、EnabledプロパティをFalseにして
書き換え不可にします。 値を取得するときはEnabledプロパティをTrueにして
代入後にFalseにするプログラムを書きます。

'コンボボックスを更新したときのプロシージャー
Private Sub cmb01_AfterUpdate()
        
        'テキストBOXにコンボボックスの値を代入するときは
        'テキストBOXの[Value]プロパティを指定する
        Me.txb_発注者.Value = Me.cmb01.Column(1)
        
        'ラベルにコンボボックス値を代入すときは
        'ラベルの[Caption]プロパティを指定する
        Me.lbl発注者.Caption = Me.cmb01.Column(1)
        
        
End Sub
7
PPP 2025/07/14 (月) 21:14:29 修正 50473@7267b

サンプルのソースコードをテーブルを作成して見てください。 
質疑応答時に双方でテーブル名、カラム名などが違いと意思疎通が
うまくいきませんので共通のテーブルでサンプルコードを実行する方が
効率よく質問事項が解決します。

質問者さんの内容はかなり複雑でありますが、コードを日常から作成していると
そんなには難しくありません。ただし、アクセスのVBAだけでは実現しませんので
ADOなどの技術を活用して質問者さんが行いたい事は可能となります。
とりあえず、アクセスのVBエディターにてADOを使用できる設定をおこなってください。
設定方法は以下のソースコードに記載しております。

適当にアクセスのファイルを作成してください
そして、フォームを作成してコマンドボタンのクリック時の
イベントに以下のコードを張り付けて、ボタンをおしてみてください
サンプルテーブルが自動で作成されます。
※事前にVBエディターのツールの参照設定に
microsoft ActivX Data object 6.1 Libraryにレ点を入れておいてください。
画像1

Private Sub コマンド6_Click()
    
    'ADO経由で取り込みテーブルのサンプルを
    '作成するためには
    'VBエディターのツールの参照設定で
    'microsoft ActivX Data object 6.1 Libraryにレ点を入れる
    '↑6.1のバージョン各PC毎違いので、お手持ちのPCの最新バージョン
    'にレ点をいれてください
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
    '取り込みテーブルの名前は[orderCapture]とする
    'ACCESSのファイルでフィールド名、テーブル名を日本語表記を採用すると
    'マイクロソフトの更新プログラムでVBAコードが全て初期化される(破棄)
    '事象がoffice2016の更新プログラムで発生したことがあるため
    'フィールド名、テーブル名、フォームに使用するオブジェクト名は
    '英語表記、ローマ字表記の方が無難
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※

    'Connectionオブジェクトのインスタンスを生成
    Dim cn As New ADODB.Connection
         '現在のAccessDBに接続
        Set cn = CurrentProject.Connection
        
    'Commandオブジェクトのインスタンスを生成%%
    Dim cm As New ADODB.Command
         'ActiveConnectionプロパティで接続の関連付けを行う
        cm.ActiveConnection = cn
        
    'CREATE TABLE文でテーブルを作成する
    Dim strSQL As String
    
        strSQL = "CREATE TABLE  orderCaptureX("
        strSQL = strSQL & "           noX  LONG"      'No
        strSQL = strSQL & "   ,partNumber  TEXT(20)"  '品番
        strSQL = strSQL & "  ,productName  TEXT(20)"  '品名
        strSQL = strSQL & "     ,quantity  LONG"      '数量
        strSQL = strSQL & "    ,UnitPrice  CURRENCY"  '単価
        strSQL = strSQL & "  ,totalamount  CURRENCY " '金額
        strSQL = strSQL & ",dayOfDelivery  DATE"      '納期
        strSQL = strSQL & "      ,remarks  TEXT(255)" '備考
        strSQL = strSQL & ",unionFormatNo  TEXT(255) " '[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号%%
        strSQL = strSQL & ")"
        Debug.Print strSQL
        
        'CommandTextプロパティにSQL文をセット
        cm.CommandText = strSQL
        
        'ExecuteメソッドでSQL文を実行
        cm.Execute
        
        'Commandオブジェクトの解放
        Set cm = Nothing
        
        'Connectionオブジェクトの解放
        cn.Close: Set cn = Nothing

        MsgBox ("サンプルテーブルが完成しました")

End Sub
9
PPP 2025/07/14 (月) 21:49:04 修正 50473@7267b >> 7

とりあえず作成したソースコードを記載します。
SQLのCREATE TABLE文で作成したアクセスファイルに
フォームを作成してコマンドボタンを1個配置して
以下のソースコードを貼付けください

コンボBOX名はcmb01
テキストボックス名は、txb_発注者
コマンドボタン名は、btn01
コンボBOXに登録するテーブルも作成します
テーブル名はtb
フィールド名は2項目
フィールド名 ID、オートナンバー型
フィールド名 フィールド1 短いテキスト

|IDフィールド1|
1AA
2BB
3cc

集合値ソース:SELECT tb.ID, tb.[フィールド1] FROM tb;

これらの設定を行ったフォームがあれば、あとは取込みたい
エクセルを用意すれば、取込みができます。

14
PPP 2025/07/14 (月) 22:04:17 修正 50473@7267b >> 9

コードが多いので分割して投稿します
分かりやすくすために番号を振っておきます
(1)VBAのコードのOption Compare Database、Option Explicit
が記載されている上部に記載するコードです。
フォーム内で共通で使用する共通変数をこの領域に記載します

Option Compare Database
Option Explicit
    '※事前にVBエディターのツルーバーにある「ツール」をクリックして
    '[参照設定]のメニューを開き
    '参照可能なライブラリーから
    '[Microsoft Office 16.0 Object Library]にレ点のチエックを入れる
    'これをしないとファイルダイアログボックスは開かれるエラーになる
    'パスを指定する
    
    'VBエディターのツールバーにある
    '「ツール」の参照設定から
    '「Microsoft Excel XX.X Object Library」
    'にレ点をいれる XX.Xは各PCのバージョンに合わす

    'コマンドボタンをクリックするイベントプロシージャーから
    '取得した変数データをCALLプロシージャーへ渡すため
    '共通変数としてここに宣言する

    'ダイアログBOXで開く場所のパスを代入する変数と
    'ファイル名を変更するときにファイルパスを取得する変数の
    '2つの変数を代入させるため配列変数で宣言
    Dim path(2) As String
    
    'エクセルのファイルを指定したパスを代入する変数
    Dim vrtSelectedItem As Variant

    'エクセル番地[A1]の値を代入
     Dim myNo As Long

    'エクセル番地[H2]の値を代入
     Dim myOrderNo As Long

    'セル番地[A11]の[No]の値を保有させる変数
    Dim cells_No As Long
    
  ’ここまでが共通変数を宣言した部分となります
16

(2)フォームに挿入したコンボBOXのイベントプロシージャです
コンボBOX名は[cmb01]です

'コンボボックスを更新したときのプロシージャー
Private Sub cmb01_AfterUpdate()
        
        'テキストBOXにコンボボックスの値を代入するときは
        'テキストBOXの[Value]プロパティを指定する
        Me.txb_発注者.Value = Me.cmb01.Column(1)
        
        'ラベルにコンボボックス値を代入すときは
        'ラベルの[Caption]プロパティを指定する
        Me.lblNO.Caption = Me.cmb01.Column(1)
           
End Sub
17
PPP 2025/07/14 (月) 22:12:48 修正 50473@7267b >> 9

(3)コマンドボタンを押したときの処理です
ここからが本題となります。

'エクセルを取り込みためのボタンをクリックしたときのイベントプロシージャー
Private Sub btn01_Click()
        
    'コンボボックスの値を選択しているかの確認
    If Me.cmb01.Value = "" Or IsNull(Me.cmb01) Then
        
        MsgBox ("コンボボックスの値を選択してください")
        
        'コンボボックスにフォーカスを移す
        Me.cmb01.SetFocus
        'コンボボックスをドロップダウンさせる
        Me.cmb01.Dropdown
        
        Exit Sub
        
    End If
    
    'FileDialogオブジェクトを宣言する
    Dim myOrderFile As FileDialog
        ' FileDialogオブジェクトを生成
        Set myOrderFile = Application.FileDialog(msoFileDialogOpen)


        '開く場所を指定(例:C:\Users\)
        '実際はエクセルデータがあるパスを代入する
        path(0) = "C:\Users\"
        
            'InitialFileNameプロパティにパスを設定
            myOrderFile.InitialFileName = path(0)


            'ダイアログのタイトルを設定
            myOrderFile.Title = "受注情報を取り込むエクセルファイルを選択してください"

                'フィルタを設定(例:エクセルファイル表示)
                myOrderFile.Filters.Clear
                myOrderFile.Filters.Add "テキストファイル", "*.xlsx"
    
                '慣れるとWithステートメント句で以下の様に省略して記述できる
                'With myOrderFile.Filters
                    '.Clear
                    '.Add "テキストファイル", "*.xlsx"
                'End With

        'ダイアログを表示
        '-1はOKボタンが押されたことを示す
        If myOrderFile.Show = -1 Then
        
            ' 選択されたファイルパスを取得
            For Each vrtSelectedItem In myOrderFile.SelectedItems
                
                'エクセルファイルのフルパスを代入する
                path(1) = vrtSelectedItem
                Debug.Print vrtSelectedItem
            
                'ここで選択されたファイルパスを使って取り込みの
                '処理を記載する
               
                    Open vrtSelectedItem For Input As #1
               
                        'ADO経由でエクセルデータを取り込む
                        'Callプロシージャーでエクセルデータを開き、セルのデータ内容を取得する
                        Call callExceltable
                        
                        'ファイルを開くときに使用した変数を閉じる
                        '閉じる処理をしないとファイルがロックされたままになるので注意
                        Close #1
            
                Next vrtSelectedItem
    
        Else
        
                ' キャンセルボタンが押された場合
                MsgBox ("ファイル選択がキャンセルされました。")
    
        End If

                Dim pos As Long
                    '[\]の位置を検索
                    pos = InStr(1, path(1), "\")
        
                'パスを取得する変数
                'エクセルファイル名より前の
                'パスの文字列を取得
                Dim firstCharacter As String
                
                'ルートパスのみの文字列を取得する
                firstCharacter = Left(path(1), pos)
            
                    '[\]が見つかった場合
                    If pos > 0 Then
            
                    Dim result As String
                        '[\]の次の文字から最後まで抽出
                        result = Mid(path(1), pos + 1)
               
                
                        'ファイル名を変える式
                        'Name oldpathname As newpathname
                        Name path(1) As firstCharacter & "取り込み済み" & result
                End If
        
                'FileDialogオブジェクトを解放する
                Set myOrderFile = Nothing
        

End Sub

18
PPP 2025/07/14 (月) 22:17:48 修正 50473@7267b >> 9

(4-1)長いので(4-1)と(4-2)(4-3)に分割して投稿します
※4-1)の部分は変数の宣言部分となります

'エクセルファイルをACCESSのテーブルにとりこむための
'コールプロシージャー
Private Sub callExceltable()
On Error Resume Next

    'エクセルのアプリケーションをNewキーワードで実体化(インスタンス化)する
    Dim myXlApp As Excel.Application
        Set myXlApp = New Excel.Application
  
    'エクセルのワークブックを
    '共通変数[vrtSelectedItem]で取得した取りこみするエクセルを
    '選択してオブジェクトを生成する
    Dim myXlWorkbook As Excel.Workbook
        Set myXlWorkbook = myXlApp.Workbooks.Open(vrtSelectedItem)
    
    'エクセルのワークシートを生成する
    'Sheet1のワークシートを指定して読み込む準備を整える
    Dim myXlWorksheet As Excel.Worksheet
        Set myXlWorksheet = myXlWorkbook.Sheets("Sheet1") '読み込むシート名を指定
        
    'エクセルの最終行の値を取得する変数
    Dim myLastRow As Long
    
        'エクセルシート入力している最終行を取得
        'セル番地[A]に入力している最終行を取得して変数へ代入する
        myLastRow = myXlWorksheet.Cells(myXlWorksheet.Rows.Count, "A").End(xlUp).Row

    '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
    '番地は固定
    
        'エクセル番地[A1]の値を代入
        myNo = myXlWorksheet.Cells(1, 1).Value
    
        'エクセル番地[H2]の値を代入(発注番号)
       myOrderNo = myXlWorksheet.Cells(2, 8).Value
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
        
        'ADO経由で取り込みテーブルにエクセルデータを転記する
        'VBエディターのツールの参照設定で
        'microsoft ActivX Data object 6.1llibraryにレ点を入れる
        
        'ADOの接続のオブジェクトの宣言を行う
        Dim cn As ADODB.Connection
        
        'ADOのレコードセットの宣言を行う
        Dim rs As ADODB.Recordset
        
            '現在のACCESSのテーブルに接続する
            Set cn = CurrentProject.Connection
            
            'レコードセットのインスタンスをNewキーワードで生成する
            Set rs = New ADODB.Recordset
                
                '取り込みをおこなう[orderCapture]テーブルを開く
                rs.Open "orderCapture", cn, adOpenKeyset, adLockOptimistic
                        
                        '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
                        '取り込むテーブル[orderCapture]に今回取り込むエクセルデータが
                        'あるかを照合する
                        '[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号が
                        'テーブルに存在すれば、取り込み済みと判断する
                        '変数を増やしたくないので配列変数で対応する
                        
                        'unionFormatNo(0)はフォーマットして取り込む文字列を生成する
                        '[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号
                        '例:[AA-1111-0001]
                        Dim unionFormatNo(2) As String
                            
                        'ForNextステートメントのカウンター変数
                        '[i]はエクセルのファイルに登録してある件数をカウントする変数
                        Dim i As Long
                            
                        '[j]はエクセルファイルを実際に登録した件数をカウント
                        'すでにあるデータは登録させないアルゴリズムを組んでいるので
                        '実際の件数をjの変数で取得させる
                        Dim j As Integer
                        '初期化しておく
                            j = 0
21
PPP 2025/07/14 (月) 22:22:11 修正 50473@7267b >> 9

(4-2)実際に処理する部分となります

'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
                      '1行ずつデータを読み込む
                      '読み込みする行は12行目から固定なので
                      'カウンター変数[i]は12から始まり、最後はエクセルデータを
                      '入力している最終行まで繰り返す
                      For i = 12 To myLastRow
                                                    
                          
                        '[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号を生成する
                        '例:[AA-1111-0001]
                        'この管理番号がACCESSのテーブルに登録された主キーとしての役目を持たせ
                        '重複して登録させない唯一の識別番号とさせる
                        unionFormatNo(0) = Me.cmb01.Column(1) & "-" & myOrderNo & "-" & Format(myXlWorksheet.Cells(i, 1).Value, "0000")
                          
                        '取り込み済みかを判定する
                        unionFormatNo(1) = Nz(DLookup("unionFormatNo", "orderCapture", "unionFormatNo ='" & unionFormatNo(0) & "'"), "Unregistered")
                          
                        'unionFormatNo(1)の値が"Unregistered"の時は登録する
                        '"Unregistered"でないときは、フォーマット形成した文字列が戻る為
                        'すでに登録済みとみなし、登録させない
                        If unionFormatNo(1) = "Unregistered" Then
                          
                              'セルA番地のNoがゼロの時は入力データなしのため
                              '取り込みしない。 ゼロより大きい値の時のみ取り込み開始
                              If myXlWorksheet.Cells(i, 1).Value <> 0 Then
                                    
                                  'ADO経由でエクセルデータの登録を開始する
                                  rs.AddNew
                                
                                      'エクセル番地の指定方法はCellsで指定する
                                      'Cells(行インデックス, 列インデックス)
                             
                                       cells_No = myXlWorksheet.Cells(i, 1).Value
                                      
                                       'セル番地[A11]の[No]の値を登録するテーブル
                                       rs!noX = myXlWorksheet.Cells(i, 1).Value

                                       'セル番地[B11]の[品番]の値を登録するテーブル
                                       rs!partNumber = myXlWorksheet.Cells(i, 2).Value
            
                                       'セル番地[C11]の[品名]の値を登録するテーブル
                                       rs!productName = myXlWorksheet.Cells(i, 3).Value
    
                                       'セル番地[D11]の[数量]の値を登録するテーブル
                                        rs!quantity = myXlWorksheet.Cells(i, 4).Value
            
                                        'セル番地[E11]の[単価]の値を登録するテーブル
                                        rs!UnitPrice = myXlWorksheet.Cells(i, 5).Value
            
                                        'セル番地[F11]の[金額]の値を登録するテーブル
                                        rs!Totalamount = myXlWorksheet.Cells(i, 6).Value:
            
                                        'セル番地[G11]の[納期]の値を登録するテーブル
                                        rs!dayOfDelivery = myXlWorksheet.Cells(i, 7).Value
            
                                        'セル番地[H11]の[発注者備考]の値を登録するテーブル
                                        rs!remarks = myXlWorksheet.Cells(i, 8).Value
                
                                        '[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号
                                        '例:[AA-1111-0001]
                                        rs!unionFormatNo = Me.cmb01.Column(1) & "-" & myOrderNo & "-" & Format(cells_No, "0000")

                                      rs.Update
                                         
                                      '登録件を更新していく
                                      j = j + 1
                                End If
                        End If

                      Next i
  
22
PPP 2025/07/14 (月) 22:23:46 修正 50473@7267b >> 9

(4-3)メモリーの解放をおこなう処理となります
これでソースコードは終了となります。

           rs.Close: Set rs = Nothing
            cn.Close: Set cn = Nothing
    
            'Excelファイルを閉じる
            myXlWorkbook.Close
    
            'Excelアプリケーションを終了する
            myXlApp.Quit

            Set myXlWorksheet = Nothing
            Set myXlWorkbook = Nothing
            Set myXlApp = Nothing
            
            MsgBox ("登録件数は" & j & "件です")
            
            
            '取り込み成功のため共通変数はゼロを代入する
            judgement = 0

End Sub

アクセスのテーブルに取り込んだサンプルデータ

画像1

画像1

画像1

画像1

画像1

23
PPP 2025/07/14 (月) 22:48:33 修正 50473@7267b >> 9

かなり長いコードとなりますが、おおむねこれで質問者さんが質問に書かれていた
エクセルの発注書に登録されているセル番地からデータを取得して転記することができます。

処理を実現するためには、ポイントとして
「Microsoft Excel XX.X Object Library」を
参照設定にて使用できるように設定をおこなう。

これは、エクセルファイルをアクセス側から読み書きできように
するための処理です。このツールを設定することを知らないと
アクセスからエクセルを自在に扱えないので、ここでつまずきます。

そして次のポイントとして、アクセスのVBAだけでは実現できない処理を
参照設定にて「microsoft ActivX Data object 6.1 Library」を使用
出来るようにしてADOを使えるようにすることです。これにより
アクセス以外のSQLServerやオラクルなどのデータベースなどと
接続することができます。 

これによりADOにおけるテーブルの更新処理なども柔軟におこなえるようになります。
なによりVBAのコード内でADOの機能を利用してVBAだけでは不可能な処理を可能とします。

外部参照設定をおこなうことにより、他のソフトなどの機能をアクセス内に
取り込めます。 

大まかにまとめると
(1)「Microsoft Excel XX.X Object Library」
(2)「microsoft ActivX Data object 6.1 Library」
参照設定にて(1)(2)の機能を取り込むことにより今回の
質問内容の処理を実行することが可能となるのです。

追記ですが(3)のソースコードに
取込み後にエクセルファイル名に「取り込み済」の文字を付加した
構文も載せています。
Nameステートメントでファイル名を書き換えております。

Name oldpathname As newpathname
26
PPP 2025/07/15 (火) 06:47:59 修正 50473@7267b >> 9

(4-2)に記載している[Private Sub callExceltable()]のコールプロシージャのままでは
取込み用のエクセル以外を選択したときの判定処理がないため、データの整合性が保てません。
なので 以下の判定用のプロシージャを追記します。

For i = 12 To myLastRow '取込みファイルかを判定する

の行にある12の部分を11に変えます。 
エクセルの11行目の項目を判定するためです。

                        For i = 11 To myLastRow
                          
'                          '11行目の項目が取り込みのエクセルファイルの形式かを判定する
'                          '取り込みするエクセルファイルであるか判定するプロシージャー
                          If i = 11 Then
'
'                            '11行目が以下の並びの項目があるかを判定する
'                            '項目名と並び順が違うと取り込みエクセルファイルでないと
'                            '判断し、以降の処理は行わない
'                            '+---+----+----+----+----+----+----+----------+
'                            '|A列|B列 |C列  |D列 |E列 |F列 |G列 | H列      |
'                            '+---+----+----+----+----+----+----+----------+
'                            '|No |品番|品名 |数量|単価|金額 |納期|発注者備考 |
'                            '+---+----+----+----+----+----+----+----------+
'
'                             '判定を繰り返すカウンター変数
                              Dim k As Integer

                              '項目を代入する配列変数
                              Dim myArrry(8) As String
                             'ゼロオリジンのため、ゼロから配列変数は始まります
                             '今回ゼロは使用しないのですが
                                 '分かりやすくするための明示しています
                                 myArrry(0) = ""
                                 myArrry(1) = "No": myArrry(2) = "品番": myArrry(3) = "品名"
                                 myArrry(4) = "数量": myArrry(5) = "単価": myArrry(6) = "金額"
                                 myArrry(7) = "納期": myArrry(8) = "発注者備考"

                                  '8項目分繰り返す
                                  For k = 1 To 8

                                   If myXlWorksheet.Cells(11, k).Value <> myArrry(k) Then

                                    MsgBox ("取り込むエクセルファイルでありませんので処理を終了")

                                        '共通変数に取り込まないエクセルファイルとして
                                        '判別する値を代入する
                                            judgement = -1

                                            '以降の処理をさせない
                                            Exit Sub


                                   End If

                                 Next k



                          End If

また [judgement]の変数は共通変数として使用するため
投稿している(1)のプログラムの最終行に判定する変数を宣言します

    '取り込むエクセルファイルかを判定した値を保有
    '-1のときは取り込まないエクセルファイルと判定する
    Dim judgement As Integer

そして投稿(3)のプロシージャに[judgement]変数に代入した
判定値をもとに、エクセルのファイル名を変更するかの条件分岐を行います

名前を変更するプログラムの場所を以下に書き換えます。

    '取り込むエクセルファイルのときは
            '名前を取り込み済みを接頭辞として付け加える
            If judgement = 0 Then
            
        
                Dim pos As Long
                    '[\]の位置を検索
                    pos = InStr(1, path(1), "\")
        
                'パスを取得する変数
                'エクセルファイル名より前の
                'パスの文字列を取得
                Dim firstCharacter As String
                
                'ルートパスのみの文字列を取得する
                firstCharacter = Left(path(1), pos)
            
                    '[\]が見つかった場合
                    If pos > 0 Then
            
                    Dim result As String
                        '[\]の次の文字から最後まで抽出
                        result = Mid(path(1), pos + 1)
               
                
                        'ファイル名を変える式
                        'Name oldpathname As newpathname
                        Name path(1) As firstCharacter & "取り込み済み" & result
                End If
        
            End If
            
        
                'FileDialogオブジェクトを解放する
                Set myOrderFile = Nothing
 
End Sub

ソースコードが長いので変更箇所が分かりづらく恐縮ですが
エクセルファイルが取込み対象かを判定する処理は盛り込んでいた方が
大勢の人が取込み処理する場合には有用であるといえます。

また取込みフォルダを固定化して、取込みたいエクセルファイルを
指定したフォルダに入れておき、取込み後、取込み済みフォルダへ
移動する方法もあります。 この方法であれば、ファイルを1個毎に
選ばず一括処理できるので業務は楽になります。 
FileSystemObjectを活用してフォルダ内のファイルを開いて
取込み処理を行うソースコードを記述して運用しております。

余談ですがEOS受信と呼ばれる方法であれば、取込みするファイルにはヘッダーとフッターとよばれる
取込み判定する行があり、データを取り込む場合はヘッダーとフッターを読み込み
取込みデータかを判定してから織り込み開始を行います。

27

処理内容が長いのキャプチャ画面を添付します。
コードが長いので、2つの画面となります。 一部重複しております。
画像1
画像1

25
PPP 2025/07/15 (火) 00:06:54 修正 50473@7267b >> 7

テーブル名は英語表記の方が無難です
ACCESSの更新プログラムで日本語表記のソースコードは
不具合が起きる事例がありますので、日本語をやめて
ローマ字表記もしくは、英語表記がいいです。

SQL文にてカラム名(フィールド名)は別名で修飾できます。
AS句の後に日本語表記のカラム名(フィールド名)を付与します。
また、テーブルAS句にて別名を付けた方がいいでしょう。
カラム名(フィールド名)にテーブル名で修飾するときも
テーブル名を簡素な別名を付与することで、カラム(フィールド名)の
修飾がたやすくなるのと、可読性があがります。
またカラム(フィールド名)を修飾するには理由があります。
 
 それは、データベースの検索を早くするのと、データを探すために
ハードディスクのオーバヘッドを軽減するためです。
ここらあたりは小難しい話になるの省略しますが、
SQL文にて別名をつけることは、セキュリティの観点からも
望ましいため、テーブルの設計時において、このことを念頭に
設計してみてください。

SELECT  e.noX AS No
      , e.partNumber AS  品番
      , e.productName AS 品名
      , e.quantity AS 数量
      , e.UnitPrice AS 単価
      , e.totalamount AS 金額
      , e.dayOfDelivery AS 納期
      , e.remarks AS 発注者備考欄
      , e.unionFormatNo AS 管理番号
 FROM  orderCapture AS e
   ;

画像1

あとハンドルネームが無いとやり取りしづらいので
ハンドルネームの記入をお願いします。
ここの回答者は親切な方ばかりなので
ハンドルネームがあったほうが、回答されやすくなりますし
固定のハンドルネームであったほうが、こないだ質問された方だなと
すぐわかるので、回答が付きやくなると思います。