Problema di importazione dati da file .XLSM tramite ActiveX Data Object

Question

Lavorando ad un'applicazione per la gestione di turni di lavoro, ho necessità di poter importare i dati da una versione precente.

Utilizzando ADO, l'importazione dei dati funziona solo con file salvati in formato Excel 2003 (.xls).

Se tento di importare i dati da una cartella di lavoro IDENTICA, ma salvata in formato Excel 2007 (.xlsm), la procedura mi ritorna il seguente errore:

• "La tabella esterna non è nel formato previsto."

La subroutine che effettua la lettura dei dati esterni è la seguente:

Public Sub ImportaArea(sFile As String, Sorgente As String, Destinazione As String, Sovrascrivi As Boolean)

Dim myConn As ADODB.Connection

Dim myCmd As ADODB.Command

Dim myRS As ADODB.Recordset

Dim riga As Integer, colonna As Integer

    On Error GoTo ADOerr

    Set myConn = New ADODB.Connection

    myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & sFile & _

        ";" & "Extended Properties=""Excel 8.0;" & "HDR=NO;IMEX=1;"""

    Set myCmd = New ADODB.Command

    myCmd.ActiveConnection = myConn

    myCmd.CommandText = "SELECT * from " & Sorgente & ""

    Set myRS = New ADODB.Recordset

    myRS.Open myCmd, , adOpenKeyset, adLockOptimistic

    myRS.MoveFirst

    Do While Not myRS.EOF

        For riga = 1 To myRS.RecordCount 'lrighe

            For colonna = 0 To myRS.Fields.Count - 1 'colonne

                If Sovrascrivi Or (Range(Destinazione).Cells(riga, colonna + 1).Formula = "") _

                Then Range(Destinazione).Cells(riga, colonna + 1).value = myRS.Fields(colonna).value

            Next

            myRS.MoveNext

        Next

    Loop

    GoTo Exit_

ADOerr:

    SysErrorMSG "Errore nell'importazione dei dati." & LF & LF & _                       ' Visualizza la descrizione ed il codice dell'errore

            "File: " & TAB_ & sFile & Chr(10) & "Sorgente dati: " & TAB_ & Sorgente

    On Error GoTo 0

    err.Raise Number:=err.Number, Description:=err.Description

Exit_:

    myConn.Close

    Set myRS = Nothing

    Set myCmd = Nothing

    Set myConn = Nothing

    On Error GoTo 0

End Sub

Sorgente e Destinazione sono i nomi degli intervalli; l'errore si presenta anche se l'intervallo è formato da una sola cella!

:-(

Grazie!

Answer 1

Grande Mauro!  :-)

All'inizio mi ha dato un pò di filo da torcere, dal momento che il codice iniziale non era mio e di gestione database non sò assolutamente nulla; comunque sono riuscito ad adattare la tua soubroutine:

Public Sub ImportaArea(sFile As String, Sorgente As String)

On Error GoTo RigaErrore

Dim cn As Object

Dim rs As Object

Dim ConnectionString$

    Set cn = CreateObject("ADODB.Connection")

    Set rs = CreateObject("ADODB.Recordset")

    If Right(sFile, 4) = ".xls" Then

        ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & sFile & _

        ";Extended Properties='Excel 8.0;HDR=NO;IMEX=1';"

    Else

        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; " _

            & "Data Source=" & sFile & _

           ";Extended Properties='Excel 12.0;HDR=NO';"

    End If

    cn.CursorLocation = 1

    cn.Open ConnectionString

    rs.CursorLocation = 1

    rs.Open "SELECT * FROM [" & Sorgente & "]", cn, 1, 3, 1

    Range(Sorgente).CopyFromRecordset rs

  .....

Ora funziona alla perfezione!!

Grazie mauro!

Bark, bark, bark!... Whoff!

PS: E' proprio necessario impostare .CursorLocation?

Bene. Grazie a te per il cortese riscontro.

Diciamo che è sempre meglio specificare da quale parte abbiamo il cursore. 1 equivale a: adUseNone (*sarebbe* obsoleto, ma dipende poi da quale db vai ad interrogare).

Vedi qui:

http://msdn.microsoft.com/en-us/library/windows/desktop/ms677542(v=vs.85).aspx

http://msdn.microsoft.com/en-us/library/windows/desktop/ms675802(v=vs.85).aspx

Answer 2

Lavorando ad un'applicazione per la gestione di turni di lavoro, ho necessità di poter importare i dati da una versione precente.

Utilizzando ADO, l'importazione dei dati funziona solo con file salvati in formato Excel 2003 (.xls).

Se tento di importare i dati da una cartella di lavoro IDENTICA, ma salvata in formato Excel 2007 (.xlsm), la procedura mi ritorna il seguente errore:

• "La tabella esterna non è nel formato previsto."

La subroutine che effettua la lettura dei dati esterni è la seguente:

Sorgente e Destinazione sono i nomi degli intervalli; l'errore si presenta anche se l'intervallo è formato da una sola cella!

:-(

Grazie!

 

Io farei così:

Public Sub mRecuperaDati()

On Error GoTo RigaErrore

    Dim cn As Object

    Dim rs As Object

    Dim sh As Worksheet

    Set cn = CreateObject("ADODB.Connection")

    Set rs = CreateObject("ADODB.Recordset")

    Set sh = Worksheets("Foglio1")

    With sh

        cn.CursorLocation = 1

        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " _

            & "Data Source=" & ThisWorkbook.Path & _

            "\tuoFile.xls" & _

           ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';"

        rs.CursorLocation = 1

        rs.Open "SELECT * FROM [Foglio1$]", cn, 1, 3, 1

        'nel caso questo copia tutto in una volta

        'rs.Range("A2").CopyFromRecordset rs

        Do Until rs.EOF

            'qui la tua gestione dei dati se

            'devi validarli record per record

            rs.MoveNext

        Loop

    End With

RigaChiusura:

    If Not rs Is Nothing Then

        If rs.State = 1 Then

            rs.Close

        End If

    End If

    If Not cn Is Nothing Then

        If cn.State = 1 Then

            cn.Close

        End If

    End If

    Set sh = Nothing

    Set rs = Nothing

    Set cn = Nothing

    Exit Sub

RigaErrore:

    MsgBox Err.Number & vbNewLine & Err.Description

    Resume RigaChiusura

End Sub

Se il file è in formato .xlsm, modifica così la Connessione:

        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " _

            & "Data Source=" & ThisWorkbook.Path & _

            "\tuoFile.xlsm" & _

           ";Extended Properties='Excel 12.0;HDR=Yes';"

NOTE.

Guarda come è indicato il nome del foglio nella query: [NomeFoglio$].

Inoltre non metto nessun riferimento alle librerie ADO perchè non so quale versione sia presente sul pc (e questa sarebbe *sempre* buona norma). Per semplificare non ho utilizzato parametri, ma se hai scritto tu il codice che hai postato, penso ti sarà semplice modificare la mia routine.

Qui di tutto di pù sulle stringhe di connessione:

http://www.connectionstrings.com/

Sempre (quasi sempre) qui se hai bisogno.

Grazie per l'attenzione.

Answer 3

Grande Mauro!  :-)

All'inizio mi ha dato un pò di filo da torcere, dal momento che il codice iniziale non era mio e di gestione database non sò assolutamente nulla; comunque sono riuscito ad adattare la tua soubroutine:

Public Sub ImportaArea(sFile As String, Sorgente As String)

On Error GoTo RigaErrore

Dim cn As Object

Dim rs As Object

Dim ConnectionString$

    Set cn = CreateObject("ADODB.Connection")

    Set rs = CreateObject("ADODB.Recordset")

    If Right(sFile, 4) = ".xls" Then

        ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & sFile & _

        ";Extended Properties='Excel 8.0;HDR=NO;IMEX=1';"

    Else

        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; " _

            & "Data Source=" & sFile & _

           ";Extended Properties='Excel 12.0;HDR=NO';"

    End If

    cn.CursorLocation = 1

    cn.Open ConnectionString

    rs.CursorLocation = 1

    rs.Open "SELECT * FROM [" & Sorgente & "]", cn, 1, 3, 1

    Range(Sorgente).CopyFromRecordset rs

  .....

Ora funziona alla perfezione!!

Grazie mauro!

Bark, bark, bark!... Whoff!

PS: E' proprio necessario impostare .CursorLocation?