MS Access: невозможно изменить тип файла в диалоговом окне «Сохранить как»

Question

У меня есть файл .mdb, созданный в Access 2003, и я хотел бы преобразовать его в файл Access .accdb 2007, но когда я перехожу к диалоговому окну «Сохранить как», он позволяет сохранить файл только в его текущем формате (.mdb)и в выпадающем списке нет никаких дополнительных форматов файлов.

То же самое происходит, когда я создаю новый .accdb и пытаюсь сохранить его как файл 2003 .mdb.Я ничего не вижу, кроме .accdb в раскрывающемся списке «Сохранить как формат файла».

Возможно, я могу запустить код VBA для сохранения в качестве нужного мне формата файла, но он не оптимален.

Кто-нибудь знает, каким может быть решение?

Спасибо, Джейк

Answer 1

'PUT THIS IN A STANDARD CLASS MODULE FIRST

Option Compare Database 
Private mstrFileName As String 
Private mblnStatus As Boolean
'Declare needed functions

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

 Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
 (pOpenfilename As OPENFILENAME) As Long

'Declare OPENFILENAME custom Type

Private Type OPENFILENAME

lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

'Function needed to call the "Save As" dialog

Public Function SaveFileDialog(lngFormHwnd As Long, _
lngAppInstance As Long, strInitDir As String, _
strFileFilter As String) As Long

Dim SaveFile As OPENFILENAME
Dim X As Long

If IsMissing(strFileName) Then strFileName = ""

With SaveFile
.lStructSize = Len(SaveFile)
.hwndOwner = lngFormHwnd
.hInstance = lngAppInstance
.lpstrFilter = strFileFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
'Use for a Default File SaveAs Name - [UD]
'.lpstrFile = "testfile.txt" & String(257 - Len("testfile.txt"), 0)
.nMaxFile = Len(SaveFile.lpstrFile) - 1
.lpstrFileTitle = SaveFile.lpstrFile
.nMaxFileTitle = SaveFile.nMaxFile
.lpstrInitialDir = strInitDir
.lpstrTitle = "Enter a Filename to Save As"        '[UD]
.Flags = 0
.lpstrDefExt = ".xls"   'Sets default file extension to Excel,
                     'in case user does not type it - [UD]
End With

X = GetSaveFileName(SaveFile)

If X = 0 Then
 mstrFileName = "none"
 mblnStatus = False
Else
 mstrFileName = Trim(SaveFile.lpstrFile)
  mblnStatus = True
End If
End Function
Public Property Let GetName(strName As String)
  mstrFileName = strName
 End Property
Public Property Get GetName() As String
  GetName = mstrFileName
 End Property
 Public Property Let GetStatus(blnStatus As Boolean)
mblnStatus = blnStatus
End Property
Public Property Get GetStatus() As Boolean
 GetStatus = mblnStatus
 End Property


'THEN WE'LL CALL IT LIKE

Private Sub cmdTest_Click()
On Error GoTo Err_cmdTest_Click
Dim cDlg As New CommonDialogAPI         'Instantiate CommonDialog
Dim lngFormHwnd As Long
Dim lngAppInstance As Long
Dim strInitDir As String
  Dim strFileFilter As String
Dim lngResult As Long

lngFormHwnd = Me.Hwnd                           'Form Handle
lngAppInstance = Application.hWndAccessApp      'Application Handle
strInitDir = "C:\"                              'Initial Directory - [UD]

'Create any Filters here - [UD]

 strFileFilter = "Excel Files (*.xls)" & Chr(0) & "*.xls" & Chr(0) & _
             "ALL Files (*.*)" & Chr(0) & "*.* & Chr(0)"
             '"Text Files (*.csv, *.txt)" & _
             'Chr(0) & "*.csv; *.txt" & Chr(0)

 lngResult = cDlg.SaveFileDialog(lngFormHwnd, _
        lngAppInstance, strInitDir, strFileFilter)

If cDlg.GetStatus = True Then
 MsgBox "You chose the Filename of: " & cDlg.GetName    'Retrieve Filename - [UD]
Else
MsgBox "No file chosen."      '[UD]
End If

Exit_cmdTest_Click:
Exit Sub

Err_cmdTest_Click:
MsgBox Err.Description, vbExclamation, "Error in cmdTest_Click()"
 Resume Exit_cmdTest_Click
 End Sub