Function 桁揃え3_n_3(txt)
Dim 分割テキスト
分割テキスト = Split(Nz(txt), "-")
If UBound(分割テキスト) <> 2 Then
桁揃え3_n_3 = Null
Exit Function
End If
分割テキスト(0) = Right("000" & 分割テキスト(0), 3)
分割テキスト(2) = Right("000" & 分割テキスト(2), 3)
桁揃え3_n_3 = Join(分割テキスト, "-")
End Function
Private Sub コマンド5_Click()
Dim dname As String
Dim destinationFolder As String
dname = "C:\アクセス\エクセル\"
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のファイル
Dim ExApp As Object
Set ExApp = CreateObject("Excel.Application")
ExApp.Visible = False '正常動作確認後、削除してもOK
Dim DesktopPath As String, FilePath As String
Dim Rng1 As String
Dim Rng2 As String
Dim Rng3 As String
Dim Rng4 As String
Dim wb As Object
Set wb = ExApp.Workbooks.Open(FileName:=f.Path) '開いたブックを変数に代入
Rng1 = wb.Worksheets("Sheet1").Cells(1, 1)
Rng2 = wb.Worksheets("Sheet1").Cells(1, 3)
Rng3 = wb.Worksheets("Sheet1").Cells(4, 1)
Rng4 = wb.Worksheets("Sheet1").Cells(4, 3)
wb.Close '開いたブックを閉じる
ExApp.Quit 'エクセルを閉じる
CurrentDb.Execute "insert into T1(f1,f2,f3,f4) VALUES('" & Rng1 & "','" & Rng2 & _
"','" & Rng3 & "','" & Rng4 & "');", dbFailOnError
If Err.Number = 0 Then 'エラーなくインポートされた
CurrentDb.Execute "UPDATE T1 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
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
End Sub
Set WSH = CreateObject("Wscript.Shell") は不要(使っていないなので)
開いたブックは変数に代入しておいて、それに対して操作する。
Set ExApp = Nothing はなくてもOK、End Sub で自動で Nothing にしてくれるので。
以上の点を考慮して修正すると下記になります。
Sub Test()
Dim ExApp As Object
Set ExApp = CreateObject("Excel.Application")
ExApp.Visible = True '正常動作確認後、削除してもOK
Dim DesktopPath As String, FilePath As String
FolderPath = "C:\アクセス\エクセル"
FilePath = FolderPath & "\エクセル操作.xlsx"
Dim Rng1 As String
Dim Rng2 As String
Dim Rng3 As String
Dim Rng4 As String
Dim wb As Object
Set wb = ExApp.Workbooks.Open(FileName:=FilePath) '開いたブックを変数に代入
Rng1 = wb.Sheets(1).Cells(1, 1)
Rng2 = wb.Sheets(1).Cells(1, 3)
Rng3 = wb.Sheets(1).Cells(4, 1)
Rng4 = wb.Sheets(1).Cells(4, 3)
wb.Close '開いたブックを閉じる
ExApp.Quit 'エクセルを閉じる
CurrentDb.Execute "insert into T1(f1,f2,f3,f4) VALUES('" & Rng1 & "','" & Rng2 & "','" & Rng3 & "','" & Rng4 & "');", dbFailOnError
End Sub
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
Dim インポート成功 As Boolean
On Error Resume Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, f.Path, True, sname
インポート成功 = Err.Number = 0
On Error GoTo 0
If インポート成功 Then
CurrentDb.Execute "UPDATE T2 SET ファイル名 = '" & f.Name & "'" & _
" WHERE ファイル名 Is Null;", dbFailOnError
On Error Resume Next
fso.MoveFile f.Path, destinationFolder 'ファイル移動
If Err Then
'//ファイル移動失敗
Debug.Print f.Name & " " & Err.Number & ":" & Err.Description
End If
On Error GoTo 0
Else
'//"インポート失敗"
Debug.Print f.Name & " " & Err.Number & ":" & Err.Description
End If
Dim dname As String
Dim tblname As String
Dim sname As String
Dim destinationFolder As String
dname = "C:\アクセス\エクセル\"
tblname = "テーブル名"
sname = "sheet3!"
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, True, sname
If Err.Number = 0 Then 'エラーなくインポートされた
CurrentDb.Execute "UPDATE T2 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
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
On Error Resume Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, dname & fname, True, sname
If Err Then
'//エラー発生時の処理
Else
'//エラーがなかった時の処理
End If
On Error Goto 0
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
UPDATE テーブル名 SET ファイル名 = 'ファイル名' WHERE ファイル名 Is Null;"
前回の私のコードに追加するなら、下記のようになります。
Public Sub Sample()
Dim dname As String
Dim tblname As String
Dim sname As String
Dim destinationFolder As String
dname = "C:\アクセス\エクセル\"
tblname = "テーブル名"
sname = "sheet3!"
destinationFolder = "C:\アクセス\エクセル\処理済\"
Dim fso As New Scripting.FileSystemObject
Dim fl As Folder
Set fl = fso.GetFolder(dname) ' フォルダを取得
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, True, sname
CurrentDb.Execute "UPDATE Sheet1 SET ファイル名 = '" & f.Name & "'" & _
" WHERE ファイル名 Is Null;", dbFailOnError
fso.MoveFile f.Path, destinationFolder 'ファイル移動
End If
Next
Set fso = Nothing
End Sub
dname, tblname, sname, destinationFolder に代入するコードがFor Each ... Eachループ内にあるのは無駄ですね。
固定値なので繰り返し代入する必要はないので、For Each ... Eachの前に移動した方がいいでしょう。
For Each f In fl.Filesはフォルダー内のすべてのファイルを取得しますので、拡張子がxlsxかどうか確認するコードが必要になります。私の回答のコードでは、GetExtensionNameで拡張子を取り出して確認してますが、他にLike演算子で下記のようなコードでも可能です。 If f.Name Like "*.xlsx" Then
Set fso = New FileSystemObject ' インスタンス化
Dim fl As Folder
Set fl = fso.GetFolder("C:\アクセス\エクセル\") ' フォルダを取得
Dim f As File
For Each f In fl.Files ' フォルダ内のファイルを取得
Debug.Print (f.Name) ' ファイルの名前 (Tips.txt) など
Debug.Print (f.Path) ' ファイルのパス (D:\Tips.txt) など
Dim dname As String
Dim fname As String
Dim tblname As String
Dim sname As String
dname = "C:\アクセス\エクセル\" 'エクセルファイルの保存フォルダ、適宜変更する。
tblname = "テーブル名" '取り込み先テーブル名、適宜変更する。
fname = f.Path 'エクセルファイル名を指定する場合*で挟む、適宜変更する。
sname = "sheet3!"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, fname, True, sname
DoCmd.RunSQL "insert into T3(ファイル名) VALUES('" & f.Name & "');"
Dim sourceFile As String
Dim destinationFolder As String
sourceFile = f.Path
destinationFolder = "C:\アクセス\エクセル\処理済\"
fso.MoveFile sourceFile, destinationFolder
Next
' 後始末
Set fso = Nothing
DoCmd.SetWarnings False
Dim dname As String
Dim fname As String
Dim tblname As String
Dim sname As String
Dim destinationFolder As String
Dim インポート成功 As Boolean
dname = "C:\アクセス\エクセル\"
tblname = "テーブル名"
fname = Dir(dname & "*.xlsx")
sname = "sheet3!"
destinationFolder = "C:\アクセス\エクセル\処理済\"
Do While fname <> ""
On Error Resume Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname,
dname & fname, True, sname
インポート成功 = Err.Number = 0
On Error Goto 0
'//ここにファイル毎の処理を追加する
If インポート成功 Then
FileCopy dname & fname, destinationFolder & fname
Kill dname & fname
'//インポートしたファイル名を書き込む処理
End If
fname = Dir()
Loop
'//(略)
Loop
fname = Dir(dname & "*.xlsx")
If fname <> "" Then MsgBox("インポートできなかったファイルがありました")
ファイル毎に処理をしているのでそこで記録を取ってもいいですね
'//(略)
Dim エラーカウント As Long
If インポート成功 Then
FileCopy dname & fname, destinationFolder & fname
Kill dname & fname
'//インポートしたファイル名を書き込む処理
Else
エラーカウント = エラーカウント + 1
End If
fname = Dir()
Loop
If エラーカウント <> 0 Then MsgBox(エラーカウント & "個のファイルがインポートできませんでした")
Public Sub Sample()
Dim dname As String
Dim tblname As String
Dim sname As String
Dim destinationFolder As String
dname = "C:\アクセス\エクセル\"
tblname = "テーブル名"
sname = "sheet3!"
destinationFolder = "C:\アクセス\エクセル\処理済\"
Dim fso As New Scripting.FileSystemObject
Dim fl As Folder
Set fl = fso.GetFolder(dname) ' フォルダを取得
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
fso.MoveFile f.Path, destinationFolder
End If
Next
Set fso = Nothing
End Sub
意味がないとは？
ポップアップはポップアップです。ACCESS本体のウィンドウにとらわれず独立したウィンドウとして操作できるようにするプロパティです
ダイアログとはなんでしょうか？
境界線スタイルの設定ならForm.BorderStyle プロパティ (Access)で確認・設定できます
もっと一般的な「ダイアログ（そのダイアログを閉じないと下部ウィンドウが触れないようなもの）」であれば作業ウィンドウ固定（Form.Modal プロパティ (Access)）プロパティを使って実装できます
これらは互いに依存するものではないのでそれぞれのプロパティをチェックして必要な判定をしてください
それぞれ独立させて抽出じゃなくて組み合わせた状態で範囲を取りたいということなんですね
データの桁数気にするのも面倒なので、独立させたまま処理させたほうがいいと思いますが、かなり複雑な条件になりますね。長整数型のコードの最大桁数が決まっている（テキスト型は桁数固定）として桁を揃えたテキスト型化するのであれば、やはりVBAで処理させてしまうのが楽でしょう
計算式でやるなら
マウスボタン解放時に設定したところ、選択できました
ありがとうございました。
度々すいません。
記載したイベントは、クリック時です。
よろしくお願いいたします。
返信ありがとうございます。
文字列を選択したいフィールド（セル!?）を選択した場合です。
ありがとうございます
やはり区切りで分割した方がいいですね
1-a-7 < 2-a-1 となるような処理も入れたかったので何とか分割してから繋ぐ形でできました
このコードは、どのオブジェクトのどのイベントで実行してますか。
データシートではコマンドボタンを配置しても表示されないので、
チェックボックスのクリック時で提示のコードを実行するサンプルを作成して動作確認しましたが、問題なく全選択されてます。
hatena様、ありがとうございます。
完璧に出来ました。
Windows API を使うことになります。
下記では、フォーカスのあるテキストボックスの座標を取得していますが、同じ方法でできると思います。
カレンダーダイアログ日付入力関数の改良版 - hatena chips
上げさせていただいたコードだと、エラーが発生したときに、ブランクのレコードができてしまったので、
の位置を
の前に変えたらうまくいったようです。
ヒトの入力はテキストを連結していても、書式が決まっているならデータ処理上では分割してしまえばいいでしょう
ハイフンで区切り、最大2回なので
InStr 関数
InStrRev 関数
ハイフン位置が分かれば文字列関数（文字列関数とその使い方）で目的の文字が取り出せます
VBA上で操作するなら配列化してしまえばもっと簡単ですね
※いずれの方式でも入力データの書式が正しいかのチェックは必要になると思います
条件の未入力を含む抽出はVBAで抽出条件（Where句）を生成し適用するのが楽だと思います
VBAが使えないときならこの掲示板でも定期ネタになりつつありそうで、（たぶん）直近の参考になりそうなリンクを貼っておきます→複数の検索ボックス
Ayameさん、hatenaさんご指摘ありがとうございます。
教えていただいた内容で、エラーが出なくなりました。シートも選択できるように修正してみました。
前回教えていただいたコードも組み合わせてなんとか複数ファイルを取り込んで、フォルダを移動させることができていると思われますが、確認していただけないでしょうか。
どうぞよろしくお願いします。
Set WSH = CreateObject("Wscript.Shell") は不要(使っていないなので)
開いたブックは変数に代入しておいて、それに対して操作する。
Set ExApp = Nothing はなくてもOK、End Sub で自動で Nothing にしてくれるので。
以上の点を考慮して修正すると下記になります。
Rng1 = Sheets(1).Cells(1, 1)
Rng2 = Sheets(1).Cells(1, 3)
Rng3 = Sheets(1).Cells(4, 1)
Rng4 = Sheets(1).Cells(4, 3)
を
Rng1 = ExApp.Sheets(1).Cells(1, 1)
Rng2 = ExApp.Sheets(1).Cells(1, 3)
Rng3 = ExApp.Sheets(1).Cells(4, 1)
Rng4 = ExApp.Sheets(1).Cells(4, 3)
でどうでしょうか？
自己解決いたしました。
ありがとうございました。
DoCmd.BrowseTo acBrowseToForm, "Ｂフォーム", "メインメニュー.NavigationSubform>取込.NavigationSubform"
hiroton様
ありがとうございました。DateDiFF関数でできました。
ありがとうございます。
そんな気がしてました。
教えていただいた処理の仕方を調べてみます。
わからないことがあれば新規に質問させていただきますので、どうぞよろしくお願いします。
りんごさん
ありがとうございます。
申し訳ありませんが
テーブルの設定
クエリのSQL が分かりません。
日付/時刻型 フィールドの規定に”0：00”を設定してまして
規定を外すと正常に動作しました。
ありがとうございました。
エクセルのデータをテーブルにインポートする場合は、１行１レコードとなりますので、A2,E2,A5,E5 というように行が異なるものをインポートすることはできません。
そのような要件なら、インポート操作以外の方法になります。
具体的には、エクセルブックを開いて(非表示で開くことも可)、シートの各セルを読み込んで、テーブルに書き込んでいく処理を書くことになります。
一から作り直しになりますので、新規に質問しなおした方がいいでしょう。
テーブルの設定とクエリのSQLを提示して下さい。
hirotonさんありがとうございます。
今回はエラーで止めるより、止めずにインポートできるものだけインポートしてインポートできなかったものは元のフォルダに戻り、インポートできなかったファイル名とエラーも出力されるので、後からわかるので、いいような気がします。
ただ、エラー処理についてほとんど考えたことがなかったので、もう一度コードを見直してみます。
もう一つ教えていただきたいことがあるのですが、質問の内容と外れているので、別の質問であげたほうがいいのかもしれませんが。
今回想定しているエクセルは、１つのファイルにレコードは一つ、フィールドは複数という想定です。
できれば列（横）方向にフィールド名、行（縦）方向にレコードになるようにしようと思っていますが、元々申請書類をそのままエクセルで印刷できるようになっているため、テーブルに保存したいデータがいろんなセルにある場合に、複数のセルを指定してインポートすることは可能でしょうか？
保存テーブルのフィールド名をf1,f2,f3,f4,f5というように作成しておいて、読み込むエクセルのセルの場所をを順番にA2,E2,A5,E5（f5にはファイル名）というように指定していこうと思っています。
一つのセルなら指定できましたが、複数となると、うまくいかないのですが、可能でしょうか？
決まった様式なので、セルの座標は固定、シートも同じなのですが、場所が点在している状態です。元のエクセルで数式を使って格子状に配列すれば良いのですが、後からの修正が困難なので、今後追加で保存したい項目が出てきたときになかなかできなくなってしまうので、アクセス側で変更できれば便利だと思い質問させていただいています。どうぞよろしくお願いします。
この中で
をいろいろ書き方を変えてみたのですが、ダメでした。
どうぞよろしくお願いします。
hirotonの回答はあくまでもエラートラップの方法についてです。具体的な案件に対するエラー対策面についてはほとんど触れていません。一概にエラートラップを入れれば解決するというものでもありません。十分に検討してください
今出ているコードの例では、「インポートに成功したがファイル移動に失敗した」という事態を想定しています（「そのような状況を許すプログラムを組んでいる」と読み取れます）
この状態で再度インポート処理が実行されたらどうなるでしょうか？
Accessはたいていの不都合ならエラーを出して止まってくれるソフトウェアです。大規模なシステムを組むとか、販売用のシステムを組むとかであればいろいろ神経質にならないといけないですが、上記のようなよほどの特殊な事態は標準のエラーに任せてしまって十分だと思います。（当然エラー発生時の対応体制は必要になります）
システムを使うユーザーレベルにそういうものだと理解してもらうのがうまく運用するコツだと思いますよ
hatenaさんに教えていただいた方法で確認してみました。
クエリを実行するとエラーが発生しました。
Err.Descriptionの中にシングルクォーテーションで括った文字が入っているのが問題のようでした。
なので、Err.Descriptionのシングルクォーテーションをダブルクォーテーションで括ったら保存できました。
確認の仕方を教えていただいてありがとうございました。とても勉強になりました。
hirotonさんエラーについて教えていただいてありがとうございます。
仕事に使うシステムになるので、不慮の事故が起きるとまずいですよね。
もっとエラーについて勉強してみます。
そんなにはないです。自分がやっている処理を正確に把握して、適切にチェックしないと不慮の事態が発生します。やり方はたいてい決まった形になるでしょう。エラー処理は難しいとされるゆえんですね
書き方ならいくつかあります
かなりくどいですが、エラーが発生しうる処理それぞれに絞ってエラー処理を組み込んでいます。コードの記述ミスに対して強い書き方でしょう
くどいですが、よくある
On Error Resume Nextの乱用問題を起こすよりはよっぽどマシですちなみに上記処理では、
CurrentDb.Executeの処理にエラートラップが掛かっていません。当然、何か処理を行えばエラーが発生する可能性があるので、ここも十分に検討が必要なポイントになります>> 14のコードを見直してみましょう
インポート処理では「テーブル名」テーブルを指定しているのにファイル名の書き込み処理では「T2」テーブルを指定しています
まぁ、ただの記述ミスなんでしょうが、実際に記述ミスがされていたとして、どうプログラムが動くのか考えてみてください。原因不明の問題に悩まされることでしょう
これについてはhatenaさん指摘の通り、エラートラップ処理を入れる前に正常な動作をするプログラムかどうかを確認すべきということです
やり方ということであれば、エラーがなかった時だけ続きの処理をやる＝エラーが発生したら中断する方向で処理を組むというのは考えられます
中断がさせやすい（分かりやすい）ように処理を専用の関数に独立させてエラートラップをしています
（関数にしなくても、
Resume line（Resume ステートメント）で同じことはできますが、ジャンプ処理はオススメしません）入れ子構造が深くなったり、
Err.Numberのチェックが繰り返されるよりはだいぶわかりやすい処理になっていると思います。ここまでするのは関数を作るコストもあるので一概に良いとは言えませんがエラー処理が複雑化する（させる）ならOn Error GoTo Labelを使った方法を考えたほうがいいと思いますコードを見る限りは問題なさそうなんですけどね。
Debug.Print の部分を下記のようにSQLを出力するようにして、そのSQLが正しいものになっているか確認して、さらに、そのSQLをクエリのSQLビューに貼り付けて実行して正しく実行されるか確認してみてください。
エラー処理のやり方がこんなにあるとは知りませんでした。もっと勉強してみます。
今回教えていただいたコードでやりたかったことがほとんどできている感じがします。
ありがとうございます。
CurrentDB.Executeでもsqlが実行できるんですね。しかも確認無しで。勉強になりました。
教えていただいたコードの中にエラー内容を別テーブル（T3）に保存するコードを追加してみたのですが、err.descriptionだけが保存できませんでした。ファイル名とエラー番号がわかるだけでもすごく助かりますが、エラー内容も一緒に保存出来たらもっとありがたいのですが、可能でしょうか？
データ型を長いテキストにしてみたのですが、やはり保存されませんでした。（イミディエイトウィンドウには出てきてるのですが）エラー番号は3011でした。
Err オブジェクト
Err.Numberは「リセット時に0」になります。その後、「エラーの発生がなければ0のまま」です。ただし、エラーが複数回発生した場合は「最後のエラー」情報になっていることに注意が必要ですOn Error Resume Nextを使ったエラー対策は、これらをしっかりと把握している必要があるということです。提示したコードはサンプルの為、できるかぎりエラートラップに焦点を絞って記述しています
エラーの結果を変数（
インポート成功）に取っているのもエラートラップに焦点を絞るためで、適切に処理できているならばのように、エラートラップ内で処理すればいいでしょう
とりあえずのエラー処理を追加したサンプルコード
追加では新規レコードとして保存されますね。やりたいことは、下記のようなことでしょうか。
取り込み先テーブル(
tblname = "テーブル名")に「フィールド名」というフィールドがあり、そのテーブルにインポートしたときに、インポートした各レコードにファイル名を書き込みたい。だとしたら、更新クエリになりますね。インポート直後に下記のようなSQLを実行すればいいでしょう。
前回の私のコードに追加するなら、下記のようになります。
DoCmd.RunSQLでSQLを実行してもいいのですが、いちいち確認メッセージがでるので、それをオフにしておいた方がいいでしょう。CurrentDb.Executeなら確認なしに実行します。エラー処理は、まずは、これが正常に動作することを確認して、各コードの意味を理解してからでいいと思います。
一気に理解しようとしても混乱するように思いますがどうでしょうか。
初心者さんのコードについてのアドバイス
コードには適切なインデント(字下げ)を付けましょう。それがいい加減だとコードが読みづらいし、バグが入り込む原因になります。
dname, tblname, sname, destinationFolder に代入するコードが
For Each ... Eachループ内にあるのは無駄ですね。固定値なので繰り返し代入する必要はないので、
For Each ... Eachの前に移動した方がいいでしょう。For Each f In fl.Filesはフォルダー内のすべてのファイルを取得しますので、拡張子がxlsxかどうか確認するコードが必要になります。私の回答のコードでは、GetExtensionNameで拡張子を取り出して確認してますが、他にLike演算子で下記のようなコードでも可能です。If f.Name Like "*.xlsx" Thenまずはエラー処理なしのコードで実行してみて、インポートに失敗するのかどうか、エラーが出るのかどうか、確認しましょう。そしてその原因が何か特定しましょう。
その原因によって、コードにエラー処理(エラー無視も含む)をすべきなのか、それとも別の対処法がいいかのか、変わってくるでしょう。(エクセルファイルが壊れている、フィールド名が異なっている、他のユーザーがエクセルをファイルを編集中など....)
私が悩んでいる間にいろいろと考えていただきありがとうございます。
なんとなく同じようになりましたが、拡張子を限定するやり方は勉強になりました。ありがとうございます。
今日作ったものに追加してみます。
ここで取得したファイル名を保存してみましたが、うまく保存できませんでした。SQLで追加してみましたが、インポートしたレコードではなく、別のレコードとして保存されてしまいました。
hirotonさんエラー処理のことを考えていただいてありがとうございます。
難しいので、教えていただいたことをよく読んで試してみます。
よくわかっていないのですが、教えていただいたコードの中で
というのは正常に処理ができた（0はエラーが発生していない）ということなのでしょうか？
初歩的な質問ですいません。
よろしくお願いします。
こんなにいろいろ教えていただけるとは思っていなかったので、本当にうれしいです。ありがとうございます。
インポートがファイル個別にできているのでそこに処理を追加すればいいですね
これも同じタイミング（ファイルごとにインポートできたタイミング）でやればいいと思います
ステートメントによるファイル処理には「ファイルの移動」がないので「コピー＆削除」で対応します
ファイル名を書き込む処理は主題からずれているので、とりあえず、「ここでやればいいよ」とだけにしておきます。具体的にはインポートファイル名が未記入のレコードに対して更新クエリを発行すればいいでしょう（別な方法でうまくいっているのであればそれでもいいと思います）
同様に、FileSystemObjectを使うかどうかもひとまず置いておきます
エラー処理について
「エラー処理をする」のと「エラーを無視して処理をする」は似ているようで異なります（テクニックのテンプレートが）
インポートできたファイルはそのフォルダからなくなっているので、「インポートできなかったファイルがある＝フォルダにファイルが残っている」ことで判断できます
ファイル毎に処理をしているのでそこで記録を取ってもいいですね
とりあえず、FileSystemObjectでファイル名取得、拡張子が xlsx のファイルをインポート後、別フォルダーへ移動するサンプルコードを書いたので置いておきます。
エラー処理の方が敷居が高いので、まずは、FileSystemObjectでフォルダー内のファイル名を取得して、それをインポート、直後にそのファイルを別フォルダーに移動する、というループ処理を作成してみてください。
それで、インポートに失敗することがあるようなら、それからエラー処理を追加するといいでしょう。
いろいろ教えていただきありがとうございます。
難しそうですが、試してみます。
時間がかかりそうですが、確認後、わからないところがあったらまたよろしくお願いします。
DoCmd.TransferSpreadsheet でインポートできなかったら通常はエラーがでるはずので、それで判断できると思います。
エラーが出たときのコードによる対処法は、下記が参考になるでしょう。
VBA エラー処理をする (On Errer GoTo)
FileSystemObjectでファイル名を取得する方法は下記が参考になるでしょう。
VBA ファイルの一覧を取得
かなり難易度は高いと思いますので、とりあえず、上記やいろいろなサイトを参考にできるところまでコードを書いてみてください。
そのうえで躓いたら、その時点でのコードを提示してここに追記質問してください。
早速教えていただきありがとうございます。
基本的にはインポートできないことは無いと考えていますが、実はまだ稼働していないシステムなので、できない場合に、どのファイルが失敗したのかを見つけ出せると便利だと思い作成を考えています。
いろいろなサイトで調べてよくわからず作ってみたので、FileSystemObjectでインポートのコードを作ってみます。
あと、インポートはDir関数、ファイル移動は FileSystemObject を使ってますが、これはどちらかに統一した方がいいでしょう。
Dir関数にはいろいろ制限があるので、FileSystemObject の方がお勧めです。
「インポートできたファイルのみ別フォルダへ移動」とのことですが、インポートに失敗するファイルがあるということですか。そのとき、エラーはでますか。それともエラーも出ずにインポートできないファイルが存在するということですか。
まずは、インポートできない原因を探るのが先決だと思いますが。
りんごさんも確認されてますが、詳細が分からないので、具体的な回答は難しいので、とりあえず高速化の一般論を提示しておきます。
どのようなことがしたいのかによって、上記のどれがいいのか、あるいは、上記のいくつかを組み合わせるがいいのか、変わってきます。