ID非公開

2022/1/8 22:52

22回答

Access VBAについて エクセルファイルをテーブルにインポートについてVBAコードを教えて頂けないでしょうか。 年度別にフォルダがあり、 2015 2016 2017 ・

Access VBAについて エクセルファイルをテーブルにインポートについてVBAコードを教えて頂けないでしょうか。 年度別にフォルダがあり、 2015 2016 2017 ・ ・ 各フォルダ内に各年度の上半期・下半期エクセルファイルがあって、 2015上半期.xlsx 2015下半期.xlsx エクセルファイル内に上半期は1月〜6月、下半期は7月〜12月までのシートがあります。 この月別の各シートのA1〜I30までを範囲指定してテーブルにインポートしたいのですが VBAコードをご教示頂けないでしょうか。 詳しい方よろしくお願いいたします。

画像

Microsoft Access | Visual Basic・212閲覧・xmlns="http://www.w3.org/2000/svg">250

ベストアンサー

0
exc********

2022/1/9 11:15

こんな感じでしょうか。 ImportExcelFile()にフォルダパスを指定してください。 問題があるかもしれませんので、新規にAccessファイルを 作成して確認してからにしてください。 Private Sub コマンド0_Click() ImportExcelFile ("c:\Users\xxxx\Desktop\Excel") End Sub Function ImportExcelFile(ByVal argDir As String) As String() Dim i As Long Dim aryDir() As String Dim aryFile() As String Dim strName As String Dim Db As DAO.Database Dim Tbl As DAO.TableDef Dim xlsFile As String Dim tblName As String ReDim aryDir(i) aryDir(i) = argDir '引数のフォルダを配列の先頭に入れる 'まずは、指定フォルダ以下の全サブフォルダを取得し、配列aryDirに入れます。 i = 0 Do strName = Dir(aryDir(i) & "\", vbDirectory) Do While strName <> "" If GetAttr(aryDir(i) & "\" & strName) And vbDirectory Then If strName <> "." And strName <> ".." Then ReDim Preserve aryDir(UBound(aryDir) + 1) aryDir(UBound(aryDir)) = aryDir(i) & "\" & strName End If End If strName = Dir() Loop i = i + 1 If i > UBound(aryDir) Then Exit Do Loop '配列aryDirの全フォルダについて、ファイルを取得し、配列aryFileに入れます。 ReDim aryFile(0) For i = 0 To UBound(aryDir) strName = Dir(aryDir(i) & "\", vbNormal + vbHidden + vbReadOnly + vbSystem) Do While strName <> "" If aryFile(0) <> "" Then ReDim Preserve aryFile(UBound(aryFile) + 1) End If aryFile(UBound(aryFile)) = aryDir(i) & "\" & strName xlsFile = aryFile(UBound(aryFile)) Set Db = OpenDatabase(xlsFile, True, True, "Excel 12.0;") For Each Tbl In Db.TableDefs tblName = Replace(Left(Tbl.Name, Len(Tbl.Name) - 2), "'", "") DoCmd.TransferSpreadsheet _ acImport, acSpreadsheetTypeExcel9, _ tblName, aryFile(UBound(aryFile)), True, tblName & "$B1:I30" Next Tbl Db.Close Set Db = Nothing strName = Dir() Loop Next ImportExcelFile = aryFile End Function

ID非公開

質問者2022/1/9 14:12

ご回答いただきありがとうございます。 すみません、 ReDim aryFile(0)のところで 配列がありません。とエラーが出ます。

ThanksImg質問者からのお礼コメント

この度はご丁寧にご回答いただきありがとうございました。何とかインポートすることができ、助かりました。

お礼日時：1/10 8:55

その他の回答（1件）

0
bbw********

2022/1/9 5:42

vbaのコードがほしいなら、マクロを作れはマクロをvbaに変換できますよ。