[ACCESS] Importare file excel in Access tramite index

[oz85]

Ciao a tutti!

Ho un codice VBA per importare un file excel che ha un nome file che varia così come, in base all'anno viene archiviato in sotto cartelle. Essendo questa disposizione abbastanza complessa ho preferito dare la possibilità a chi utilizza il Database, di scegliere il file.

Il problema è che anche i nomi dei Foglio variano in base all'anno ma in comune hanno sia il range sia il numero foglio, ovvero il terzo.

Ho letto che tramite Index è possibile far riferimento al foglio in questione tralasciando la nomenclatura. Vi posto il codice che ad oggi funziona ma che fa riferimento ad un nome specifico. Potete aiutarmi a capire come editare il codice così che possa sempre importare il terzo foglio? Grazie!

Codice: Seleziona tutto

Sub provaCarico()

'Importa il file Carico dal percorso di rete con scelta file

'On Error GoTo Esci

'cancello tutta la tabella Carico
DoCmd.RunSQL "DELETE * FROM Carico;"

Dim SelectedFile    As String
Dim FilePicker      As FileDialog
Dim SQLdelete       As String

'apro il filedialog e scelgo il file di Carico
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
FilePicker.AllowMultiSelect = False
FilePicker.Filters.Add "Excel", "*.xls*", 1
FilePicker.InitialFileName = "C:\Users\*****************\Desktop\CARICO TEST\"
FilePicker.Title = "Seleziona il file di Carico"
FilePicker.Show

If FilePicker.SelectedItems.Count <> 0 Then
SelectedFile = FilePicker.SelectedItems(1)

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, "CARICO 2018!A1:R50607"


'MsgBox ("Dati caricati")

End If

'Esci: Exit Sub



End Sub

[Anthony47]

Premetto che di Access sono un emerito incompetente, comunque da quello che leggo il metodo TransferSpreadsheet non accetta un Range dichiarato come indice del foglio.
Potresti pero' aprire in modo nascosto il file e rilevare il nome del foglio, prima di procedere con la tua importazione.
Questo "probabilmente" lo puoi ottenere con questo codice da aggiungere al tuo:

Codice: Seleziona tutto

'....
SelectedFile = FilePicker.SelectedItems(1)
'>>> Questo si aggiunge:
Dim WXL As Object, WWb As Object, ShName As String                 '<<< Questa riga meglio posizionarla insieme alle altre Dim
Set WXL = CreateObject("Excel.Application")
Set WWb = WXL.Workbooks.Open(SelectedFile)
ShName = WWb.sheets(1).Name
WWb.Close False
WXL.Quit
Set WXL = Nothing
Set WWb = Nothing
'<<< FINE dell'aggiunta
'Segue il tuo DoCmd modificato:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, ShName & "!A1:R50607"        'Modificato
'seguono le altre istruzioni
'....


Ripeto "probabilmente" perche' non sono in grado di collauduare l'istruzione DoCmd; comunque non dovrebbe essere una variazione distruttiva...

Ciao

[oz85]

Grazie Anthony per l'aiuto! funziona tutto dopo che ho effettuato qualche operazione di tagli a e cuci. Ora il tutto funziona correttamente senza dover nominare il numero del foglio. Provo a farla un pò più complicata. Ho notato che i file che importo hanno un nome variabile e anche la posizione del file stesso è una variabile in quanto si sposta in sottocartelle di anni.

Detto ciò, l'ulteriore problema che sto notando è che il foglio che mi occorre importare a volte è il foglio 2 del file anzichè li terzo. Il nome del foglio invece è sempre composto da "CARICO" e dall'anno. ESEMPIO: "CARICO 2018" o "CARICO 2019".

Potrei fare una ricerca del parziale (CARICO) e selezionare quel worksheet?

Codice: Seleziona tutto

Private Sub ImportCarico()

'On Error GoTo Esci

'cancello tutta la tabella Carico
DoCmd.RunSQL "DELETE * FROM Carico;"

Dim SelectedFile    As String
Dim FilePicker      As FileDialog
Dim SQLdelete       As String
'modifica Anthony
Dim WXL As Object, WWb As Object, ShName As String


'apro il filedialog e scelgo il file di Carico
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
FilePicker.AllowMultiSelect = False
FilePicker.Filters.Add "Excel", "*.xls*", 1
FilePicker.InitialFileName = "C:\Users\***************\Desktop\CARICO TEST\"
FilePicker.Title = "Seleziona il file di Carico"
FilePicker.Show

If FilePicker.SelectedItems.Count <> 0 Then
SelectedFile = FilePicker.SelectedItems(1)

'modifica Anthony
Set WXL = CreateObject("Excel.Application")
Set WWb = WXL.Workbooks.Open(SelectedFile)
ShName = WWb.sheets(3).Name
WWb.Close False
WXL.Quit
Set WXL = Nothing
Set WWb = Nothing

'originale
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, "CARICO 2018!A1:R50607"
'modifica Anthony
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, ShName & "!A1:R50607"

'assegno data lbl_Carico
lbl_DataImportazioneCarico.Value = Now()

MsgBox ("Dati caricati")

End If

'Esci: Exit Sub


End Sub

Premetto che di Access sono un emerito incompetente, comunque da quello che leggo il metodo TransferSpreadsheet non accetta un Range dichiarato come indice del foglio.
Potresti pero' aprire in modo nascosto il file e rilevare il nome del foglio, prima di procedere con la tua importazione.
Questo "probabilmente" lo puoi ottenere con questo codice da aggiungere al tuo:

Codice: Seleziona tutto

'....
SelectedFile = FilePicker.SelectedItems(1)
'>>> Questo si aggiunge:
Dim WXL As Object, WWb As Object, ShName As String                 '<<< Questa riga meglio posizionarla insieme alle altre Dim
Set WXL = CreateObject("Excel.Application")
Set WWb = WXL.Workbooks.Open(SelectedFile)
ShName = WWb.sheets(1).Name
WWb.Close False
WXL.Quit
Set WXL = Nothing
Set WWb = Nothing
'<<< FINE dell'aggiunta
'Segue il tuo DoCmd modificato:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, ShName & "!A1:R50607"        'Modificato
'seguono le altre istruzioni
'....


Ripeto "probabilmente" perche' non sono in grado di collauduare l'istruzione DoCmd; comunque non dovrebbe essere una variazione distruttiva...

Ciao

[Anthony47]

In questo caso devi, una volta aperto il file, scansionare i fogli e vedere quale ti interessa; il cuore della macro dovrebbe essere questo (non farai fatica ad adattarle al tuo caso, credo):

Codice: Seleziona tutto

If FilePicker.SelectedItems.Count <> 0 Then
   SelectedFile = FilePicker.SelectedItems(1)
    Dim WXL As Object, WWb As Object, ShName As String, I As Long
    Set WXL = CreateObject("Excel.Application")
    Set WWb = WXL.Workbooks.Open(SelectedFile)
    For I = 1 To WWb.sheets.Count
        If UCase(Left(WWb.sheets(I).Name, 6)) = "CARICO" Then
            ShName = WWb.sheets(I).Name
            Exit For
        End If
    Next I
    WWb.Close False
    WXL.Quit
    Set WXL = Nothing
    Set WWb = Nothing
    If ShName <> "" Then
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, ShName & "!A1:R50607"
        lbl_DataImportazioneCarico.Value = Now()
        MsgBox ("Dati caricati")
    Else
        MsgBox ("Dati NON caricati (foglio CARICO xxx mancante)")
    End If
End If


Questo cerca il foglio chiamato CARICOxyzwy e lo utilizza.
Potrebbe essere necessario "incapsulare" il nome foglio tra "apostrofi"; in questo caso prova a modificare la riga DoCmd, sostituendo ShName & "!A1:R50607" con

Codice: Seleziona tutto

"'" & ShName & "'!A1:R50607"

Prova...

[oz85]

Ho adattato il codice e funziona tutto correttamente, grazie di tutto Anthony! codice SUPER!

In questo caso devi, una volta aperto il file, scansionare i fogli e vedere quale ti interessa; il cuore della macro dovrebbe essere questo (non farai fatica ad adattarle al tuo caso, credo):

Codice: Seleziona tutto

If FilePicker.SelectedItems.Count <> 0 Then
   SelectedFile = FilePicker.SelectedItems(1)
    Dim WXL As Object, WWb As Object, ShName As String, I As Long
    Set WXL = CreateObject("Excel.Application")
    Set WWb = WXL.Workbooks.Open(SelectedFile)
    For I = 1 To WWb.sheets.Count
        If UCase(Left(WWb.sheets(I).Name, 6)) = "CARICO" Then
            ShName = WWb.sheets(I).Name
            Exit For
        End If
    Next I
    WWb.Close False
    WXL.Quit
    Set WXL = Nothing
    Set WWb = Nothing
    If ShName <> "" Then
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Carico", SelectedFile, True, ShName & "!A1:R50607"
        lbl_DataImportazioneCarico.Value = Now()
        MsgBox ("Dati caricati")
    Else
        MsgBox ("Dati NON caricati (foglio CARICO xxx mancante)")
    End If
End If


Questo cerca il foglio chiamato CARICOxyzwy e lo utilizza.
Potrebbe essere necessario "incapsulare" il nome foglio tra "apostrofi"; in questo caso prova a modificare la riga DoCmd, sostituendo ShName & "!A1:R50607" con

Codice: Seleziona tutto

"'" & ShName & "'!A1:R50607"

Prova...