Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Errore ADODB.Connection

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Errore ADODB.Connection

Postdi deniel69 » 06/01/15 18:55

Ciao a tutti ...ormai qui sono di casa...visto che vengo spesso a porre quesiti...

Ecco il prossimo....

Ho una sub che ho copiato da una cartella excel al mio file personal.xlsb ,ma mentre nella cartella originale funziona
se la lancio dal mio XLSB va in errore nel punto indicato dalla freccia......

Con la prima parte cerco e il file excel da aprire e leggo i fogli (ovviamente è tutto in una Userform).

Option Explicit

Private Sub btnBrowse_Click()
Dim FName As Variant
FName = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
If FName = False Then
Exit Sub
End If
Me.tbxWorkbook.Text = FName
ListSheets CStr(FName)

End Sub


Private Sub ListSheets(WBName As String)
Dim CN As ADODB.Connection <=================== Quì mi da ERRORE
Dim RS As ADODB.Recordset
Dim TableName As String

Set CN = New ADODB.Connection
With CN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=""Excel 8.0;"""
.Open
Set RS = .OpenSchema(adSchemaTables)
End With

Me.lbxSheets.Clear
Do While Not RS.EOF
TableName = RS.Fields("table_name").Value
If Right$(TableName, 1) = "$" Then
Me.lbxSheets.AddItem Left(TableName, Len(TableName) - 1)
End If
RS.MoveNext
Loop
RS.Close
CN.Close
End Sub

Il file su cui funziona è un xls .... può voler dire qualcosa?
Avatar utente
deniel69
Utente Senior
 
Post: 113
Iscritto il: 17/04/12 22:43

Sponsor
 

Re: Errore ADODB.Connection

Postdi Anthony47 » 06/01/15 19:15

Secondo me ti manca il riferimento a una delle Microsoft Activex Data Object library che nel VbaProject originale e' invece impostato ; dal vba:
-Menu /Strumenti /Riferimenti
-controlla che ci sia il link

Pero, permetti la domanda: sai che cosa stai facendo? Sei sicuro che non ci sia un modo piu' semplice per fare quel che devi fare?

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore ADODB.Connection

Postdi deniel69 » 06/01/15 21:04

Ciao Anthony47 ,come dici tu mancava il riferimento e si un modo più semplice sicuramente c'è.....e dovrò cercarlo...

Volevo usare ciò che avevo che era funzionante e aggiungerlo al mio file XLSB...... ma così non funziona correttamente.
In primis perché posso leggere solo i file .xls.

Con il file funzionante aprivo una form nel quale con un tasto cercavo e sceglievo il file da cui copiare il foglio che mi interessava
foglio che sceglievo da una listbox e poi tramite un altro tasto copiavo il foglio nella cartella corrente........

Devo riscrivere qualcosa da adattare alla mia userform....
Avatar utente
deniel69
Utente Senior
 
Post: 113
Iscritto il: 17/04/12 22:43

Re: Errore ADODB.Connection

Postdi Anthony47 » 07/01/15 11:46

Non ho capito perche' "ma così non funziona correttamente ... perché posso leggere solo i file .xls"; poi poter selezionare sia xls che xlsx che xslm che xslb con l' istruzione
Codice: Seleziona tutto
FName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Seleziona il file")


Per la ADOB connection puoi o aggiungere il riferimento mancante nel tuo VbaProject, oppure lavorare in "late binding" usando Set CN = CreateObject("ADODB.Connection") invece di Set CN = New ADODB.Connection (previa modifica delle Dim di CN e RS in Object)
Il codice aggiornato per il "late bindind" e'
Codice: Seleziona tutto
Private Sub ListSheets(WBName As String)
Dim CN As Object 'ADODB.Connection '<=======
Dim RS As Object  ' ADODB.Recordset
Dim TableName As String

Set CN = CreateObject("ADODB.Connection")

With CN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=""Excel 8.0;"""
.Open
Set RS = .OpenSchema(20)    'adSchemaTables
End With

Me.lbxSheets.Clear
Do While Not RS.EOF
    TableName = RS.Fields("table_name").Value
    If Right$(TableName, 1) = "$" Then
        Me.lbxSheets.AddItem Left(TableName, Len(TableName) - 1)
    End If
    RS.MoveNext
Loop
RS.Close
CN.Close
End Sub

Questo ti dovrebbe consentire di continuare a usare quello che hai sviluppato.

Ricorda comunque che quello che metti nel tuo personal.xls rimane sul tuo pc, cioe' non viaggia col file che quelle macro le sfrutta, ne' puoi pensare di costringere gli eventuali utenti a installare il tuo personal.xls.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore ADODB.Connection

Postdi deniel69 » 07/01/15 23:30

Grazie Anthony47.....

Riguardo al personal.xlsb ....lo so che è residente solo sul mio PC ,ed infatti è per mio uso personale.
File che ora che comincia a prendere corpo ho trasformato in Personal.xlam.

Comunque ora che grazie ad un po di testa contro il muro ed al vostro aiuto ho modificato e messo insieme quanto segue
che inizialmente apriva e copiava un foglio da una cartella chiusa ed ora da la possibilità di scegliere due file e due fogli diversi
e copiarli nella Cartel1..... (perché a me così serve).

Il codice va inserito in una Userform composta da:
2 textbox ,2 listbox e 4 commandbutton.................. Come sempre sicuramente migliorabile ,come per esempio poter scegliere piu tipi di estensioni contemporaneamente (.xls - .xlsx - etc etc etc .) ma comunque funzionante........

Di seguito il codice:


Codice: Seleziona tutto
Option Explicit

Private Sub btnBrowse1_Click()
    Dim FName1 As Variant
    FName1 = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
    If FName1 = False Then
        Exit Sub
    End If
    Me.tbxWorkbook1.Text = FName1
    ListSheets1 CStr(FName1)
End Sub

Private Sub ListSheets1(WBName1 As String)
Dim CN As Object 'ADODB.Connection '<=======
Dim RS As Object  ' ADODB.Recordset
Dim TableName1 As String

Set CN = CreateObject("ADODB.Connection")

With CN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName1 & ";" & _
"Extended Properties=""Excel 8.0;"""
.Open
Set RS = .OpenSchema(20)    'adSchemaTables
End With

Me.lbxSheets1.Clear
Do While Not RS.EOF
    TableName1 = RS.Fields("table_name").Value
    If Right$(TableName1, 1) = "$" Then
        Me.lbxSheets1.AddItem Left(TableName1, Len(TableName1) - 1)
    End If
    RS.MoveNext
Loop
RS.Close
CN.Close
End Sub


'------------------------ Seconda finestra
Private Sub btnBrowse2_Click()
    Dim FName2 As Variant
    FName2 = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
    If FName2 = False Then
        Exit Sub
    End If
    Me.tbxWorkbook2.Text = FName2
    ListSheets2 CStr(FName2)
   
End Sub

Private Sub ListSheets2(WBName2 As String)
Dim CN As Object 'ADODB.Connection '<=======
Dim RS As Object  ' ADODB.Recordset
Dim TableName2 As String

Set CN = CreateObject("ADODB.Connection")

With CN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName2 & ";" & _
"Extended Properties=""Excel 8.0;"""
.Open
Set RS = .OpenSchema(20)    'adSchemaTables
End With

Me.lbxSheets2.Clear
Do While Not RS.EOF
    TableName2 = RS.Fields("table_name").Value
    If Right$(TableName2, 1) = "$" Then
        Me.lbxSheets2.AddItem Left(TableName2, Len(TableName2) - 1)
    End If
    RS.MoveNext
Loop
RS.Close
CN.Close
End Sub

Private Sub btnCopySheet_Click()
    Dim WB As Workbook
    Dim WS As Worksheet
   
'<==== Prima copia
    If Me.lbxSheets1.Value = vbNullString Or Me.lbxSheets2.Value = vbNullString Then
        MsgBox ("Devi effettuare tutte le scelte necessarie")
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set WB = Application.Workbooks.Open(Me.tbxWorkbook1.Text)
    Set WS = WB.Worksheets(Me.lbxSheets1.Value)

With ThisWorkbook.Worksheets
       WS.Copy before:=Workbooks("Cartel1.xlsx").Sheets("Foglio1")
       ActiveSheet.Name = "Archivio"
    End With
    WB.Close savechanges:=False
   
'<==== Seconda copia

    If Me.lbxSheets2.Value = vbNullString Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set WB = Application.Workbooks.Open(Me.tbxWorkbook2.Text)
    Set WS = WB.Worksheets(Me.lbxSheets2.Value)

With ThisWorkbook.Worksheets
       WS.Copy after:=Workbooks("Cartel1.xlsx").Sheets("Archivio")
       ActiveSheet.Name = "Nuovo"
    End With
    WB.Close savechanges:=False
'-------------------------------------
    Application.ScreenUpdating = True
    Unload Me
End Sub

Private Sub btnClose_Click()
Unload Me
End Sub



Grazie ..........
Avatar utente
deniel69
Utente Senior
 
Post: 113
Iscritto il: 17/04/12 22:43

Re: Errore ADODB.Connection

Postdi Anthony47 » 08/01/15 11:34

Come sempre sicuramente migliorabile ,come per esempio poter scegliere piu tipi di estensioni contemporaneamente (.xls - .xlsx - etc etc etc .)

Per selezionare tutti i tipi di file Excel devi usare l'istruzione che ti avevo dato nel messaggio precedente:
Codice: Seleziona tutto
FName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Seleziona il file")

Poi, visto che in ogni caso i file che selezioni vanno aperti, l' uso della ADODB.Connection e' assolutamente una complicazione: apri il file, leggi i nomi dei suoi N worksheets, popoli il listbox.

Ti prego di usare il tag "Code" per il codice che alleghi, il messaggio ne guadagna in leggibilita': selezioni il testo da marcare come Codice, premi il pulsante Code che trovi in testa al textbox in cui stai inserendo il messaggio.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore ADODB.Connection

Postdi deniel69 » 08/01/15 18:56

Ciao Anthony ,chiedo scusa per tag "Code" ,ci starò attento.

Grazie ancora.
Avatar utente
deniel69
Utente Senior
 
Post: 113
Iscritto il: 17/04/12 22:43


Torna a Applicazioni Office Windows


Topic correlati a "Errore ADODB.Connection":

Errore strano
Autore: Mr.Frank
Forum: Software Windows
Risposte: 0

Chi c’è in linea

Visitano il forum: Nessuno e 18 ospiti