Microsoft Access 掲示板

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