Problemi con DoCmd.Tranfertdatabase

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
With dlgOpen

  .AllowMultiSelect = True 
  .Show

End With

ecc...
Option Compare Database
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
            Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
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
Public Function cmdlg_file()
   Dim OpenFile As OPENFILENAME
   Dim lReturn As Long
   Dim sFilter As String

   OpenFile.lStructSize = Len(OpenFile)
   sFilter = "Database (*.accdb)" & Chr(0) & "*.accdb" & Chr(0)
   OpenFile.hwndOwner = Application.hWndAccessApp
   OpenFile.lpstrFilter = sFilter
   OpenFile.nFilterIndex = 1
   OpenFile.lpstrFile = String(257, 0)
   OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
   OpenFile.lpstrFileTitle = OpenFile.lpstrFile
   OpenFile.nMaxFileTitle = OpenFile.nMaxFile
   OpenFile.lpstrInitialDir = "C:\Documenti\Immagini"
   OpenFile.lpstrTitle = "Selezione"
   OpenFile.flags = 0
   lReturn = GetOpenFileName(OpenFile)

   If lReturn = 0 Then
      cmdlg_file = ""

   Else
      cmdlg_file = Left(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, Chr$(0)) - 1)
   End If
End Function

Option Compare Database
Dim Nomefile  As String

Private Sub Carica()
On Error GoTo Errore
Nomefile = cmdlg_file
Errore:
Exit Sub
End Sub

Private Sub Comando0_Click()
DoCmd.TransferDatabase acImport, "Microsoft Access",  Nomefile, acTable, "iscritti", _
    "iscritti"
 End Sub

Function TableExists(TableName As String) As Boolean

Dim strTableNameCheck
On Error GoTo ErrorCode

strTableNameCheck = CurrentDb.TableDefs(TableName)

TableExists = True

ExitHere:
    On Error Resume Next
    Exit Function

ErrorCode:
    Select Case Err.Number
        Case 3265  'Item non trovato nella Collection TABLEDEFS
            TableExists = False
            Resume ExitHere
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
            Resume ExitHere
    End Select

End Function

    DBEngine(0)(0).TableDefs.Delete NomeTabella