ACCESS VBA(インポート・エクスポート)

Private Sub インポート_Click()
Dim msg As String
msg = getFilePicker
If msg = “” Then Exit Sub

DoCmd.TransferSpreadsheet acImportDelim, , “インポートデータ”, msg, True
MsgBox “インポートしました”
Exit Sub
End Sub

Function getFilePicker(Optional dTitle As String = “ファイル選択”)

Const msoFileDialogFilePicker As Integer = 3
Dim fDlg As Object
Set fDlg = Application.FileDialog(msoFileDialogFilePicker)

fDlg.Title = dTitle
fDlg.InitialFileName = CurrentProject.Path
fDlg.AllowMultiSelect = False
fDlg.Filters.Clear
fDlg.Filters.Add “すべてのファイル”, “.“
fDlg.Filters.Add “Excel Files(.xlsx)”, “.xlsx”
fDlg.FilterIndex = 1

If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = “”
End Function

Private Sub エクスポート_Click()
Dim Path As String
Path = CreateObject(“WScript.Shell”).Specialfolders(“Desktop”) & “\” & “利用履歴.xlsx”
DoCmd.TransferSpreadsheet acExport, , “エクスポートデータ”, Path, True, “”
MsgBox “エクスポートされました”
End Sub