Private Sub コマンド7_Click()
Dim sFina As String
sFina = SaveFile_FileDialog
If sFina <> "" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "テーブル名", sFina, True, "シートxxx名"
End If
End Sub
Public Function SaveFile_FileDialog() As String
Dim oexcel As New Excel.Application
sfile = oexcel.GetSaveAsFilename( _
FileFilter:="Excelファイル,*.xls,全てのファイル,*.*", _
FilterIndex:=1, _
InitialFileName:="名前を変更.xls", _
Title:="名前を付けて保存")
If sfile = "False" Then
SaveFile_FileDialog = ""
Else
SaveFile_FileDialog = sfile
End If
Set oexcel = Nothing
End Function
Private Sub インポートボタン_Click()
Dim df As FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Any file", "*.*", 1
.Filters.Add "excelファイル", "*.xls; *.xlsx", 2
.FilterIndex = 2
If .Show Then
Me.txt_ダイアログ = .SelectedItems.Item(1)
End If
End With
End Sub
インポートコマンド処理
Private Sub コマンド6_Click()
Dim strpath As String
strpath = Me.txt_ダイアログ
'tableXにインポートする
DoCmd.TransferSpreadsheet acImport, , "テーブル名", strpath, True, "シート名!"
End Sub
コメント