access vba　エクセルの列を選択してインポート出来るフォーム

初めに

access vbaでのエクセルインポートには色々な方法がありますがエクセルの列項目を表示して選択しインポートするフォームを作成しましたので紹介します。

フォーム画面

①インポートファイル選択
②フィルド表示
③エクセルインポート
④テーブル確認
⑤エクスポートフォルダ選択
⑥エクセルエクスポート
⑦終了

概要

エくセルファイルを選択すると列項目分のオプションボタン、テキストボックスには列項目が表示されます。

最大表示列項目は255です。

列項目を見て不要な項目を選択しインポートを実行するとテーブルに必要項目のみがフィルドとしてテーブル”DATA”としてインポートされます。

操作手順

エクセルファイル選択

①インポートファイル選択の右のテキストボックスをクリックするとファイルダイアログが開くのでエクセルファイルを選択する。

読み込むシートは一番前にしてください。

コード

Private Sub ファイル選択_Click()
‘—-テキストボックスとオプションボタンを非表示にする
For I = 1 To 255
Me(“T” & I).Visible = False
Me(“O” & I).Visible = False
Next I
ファイル選択 = “”
‘—-ファイルダイアログ呼び出し
Call FileSelect
‘—エクセルファイルか確認　FLG=1ならエクセルファイル
If FLG = 0 Then MsgBox (“エクセルファイルでは有りません”): Exit Sub
ファイル選択 = FLNAM
End Sub

————————————————————————————–

Function FileSelect()
‘—ファイルダイアログ表示
Dim tgfn As Variant
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then
For Each tgfn In .SelectedItems
sfn = tgfn
Next
FLNAM = sfn
End If
End With
‘—-エクセルファイル確認フラッグ
FLG = 0
EX = Right$(FLNAM, 6)
If InStr(1, EX, “.xl”) <> 0 Then FLG = 1
End Function

エクセルファイル読込

②フィルド表示ボタンをクリックする。

列項目が表示される

コード

Private Sub フィルド表示_Click()
On Error GoTo AAA
‘—-DATAテーブルが有れば削除
Dim TB As DAO.TableDef
IsTable = False
For Each TB In CurrentDb.TableDefs
If TB.Name = “DATA” Then
IsTable = True
DoCmd.DeleteObject acTable, “DATA”
GoTo 10
End If
Next
10

‘—-フィルをDATAテーブルにそのままインポート
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, “DATA”, FLNAM, True
Dim DA As Database
Dim DB As Recordset
Dim FINAME(255)
Set DA = CurrentDb
Set DB = DA.OpenRecordset(“DATA”)
‘—-フィルドを表示するテキストボックスと選択するオプションボタンを表示する
For i = 1 To DB.Fields.Count
Me(“O” & i).Visible = True
Me(“O” & i) = 1
Me(“T” & i).Visible = True
Next i
‘—フォーム上にフィルド名を表示
For i = 0 To DB.Fields.Count – 1
Me(“T” & i + 1) = DB.Fields(i).Name
Next i
GoTo OWARI
AAA: If Err = 32605 Then MsgBox (“列数は最大255までです”): Resume: Exit Sub
OWARI:
End Sub

項目選択

不要な項目のオプションボタンをクリックして選択を外す。

エクセルインポート

③エクセルインポートボタンをクリックすると読み込まれている”DATA”テーブルから選択したフィルドを削除する。

削除された状態のフィルド項目にフォーム上のテキストボックスは変更される。

コード

Private Sub エクセルインポート_Click()
Dim DB As Recordset
Dim FINAME(255)
Set DA = CurrentDb
Set DB = DA.OpenRecordset(“DATA”)
DBREC = DB.Fields.Count
DB.Close: Set DB = Nothing

‘—不要なフィルド削除
For i = 1 To DBREC
If Me(“O” & i) = 0 Then DA.Execute “ALTER TABLE DATA DROP COLUMN ” & Me(“T” & i)
Next i
Set DB = DA.OpenRecordset(“DATA”)
For i = 1 To 255
Me(“O” & i) = 1
Me(“T” & i) = “”
Me(“T” & i).Visible = False
Me(“O” & i).Visible = False
Next i

‘—不要なフィルド削除したフィルドを表示
For i = 1 To DB.Fields.Count
Me(“O” & i).Visible = True
Me(“O” & i) = 1
Me(“T” & i).Visible = True
Next i
For i = 0 To DB.Fields.Count – 1
Me(“T” & i + 1) = DB.Fields(i).Name
Next i
End Sub

インポートテーブル確認

保存された”DATA”テーブルの内容を確認する。

A5からA8まで削除されている。

コード

Private Sub テーブル確認_Click()
DoCmd.OpenTable “DATA”, acViewNormal
End Sub

エクスポートフォルダ選択

必要項目だけになったテーブルをエクセルファイルとしてエクスポートする

⑤エクスポートフォルダ選択の右テキストボックスをクリックするとフォルダ選択ダイアログが表示されるのでエクスポートするフォルダを選択しOKをクリックする。

コード

Private Sub フォルダ選択_Click()
フォルダ選択 = “”
Call SaveAsFile
End Sub
———————————————————————
Function SaveAsFile()
‘選択したフォルダ名を格納する変数
Dim SelF As String
With Application.FileDialog(msoFileDialogFolderPicker)
‘ダイアログボックスを表示
If .Show = True Then
‘OKボタンが押された場合、フォルダ名を取得する
SelF = .SelectedItems(1)
‘メッセージを表示
End If
End With
If Right$(SelF, 1) = “\” Then SelF = Left$(SelF, Len(SelF) – 1)
フォルダ選択 = SelF
End Function

エクスポート

⑥エクセルエクスポートボタンをクリックするとエクスポートされる。

完了メッセージが表示される。

コード

Private Sub エクセルエクスポート_Click()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, “DATA”, フォルダ選択 & “\DATA.xlsx”, True
MsgBox (フォルダ選択 & “\にDATA.xlsxで””出力完了しました。”): Exit Sub
End Sub