主要代码：

    Dim strFolderPath As String
    Dim tbl As TableDef
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = CurrentProject.Path
        If Not .Show Then Exit Sub
        strFolderPath = .SelectedItems(1)
    End With

    strName = "导出Access表" & Format(Date, "YYYY-MM-DD") & ".mdb"

    strFolderPath = strFolderPath & "\" & strName
    If Dir(strFolderPath) <> "" Then Kill strFolderPath
    CreateDatabase strFolderPath, dbLangGeneral
    For Each tbl In CurrentDb.TableDefs
        If Not tbl.Name Like "Msys*" Then
            DoCmd.TransferDatabase acExport, "Microsoft Access", strFolderPath, acTable, tbl.Name, tbl.Name, False
        End If
    Next
    MsgBox "导出成功。", vbInformation

示例下载:

点击下载此附件

演   示: