XL 2019 Problème avec le code VBA sur un PC

tanyssa

XLDnaute Nouveau
Bonjour,

J'ai un fichier excel avec du code VBA qui fonctionne depuis des années. Je change de PC et j'ai des erreurs au niveau du code.
Il s'agit d'un Windows 10. Sur mon PC qui est également un Windows 10, je n'ai aucun souci pour faire fonctionner le code.
J'ai du code qui va lire dans un fichier mdb, ce n'est plus possible, j'ai du code qui vérifie les applications Office, il ne fonctionne plus non plus.
Ci-joint, les copies d'écran. D'après les messages d'erreur, on pourrait penser à un problème d'architecture, il s'agit d'un système 64 bits mais ce n'est pas cela car ce fichier fonctionne sur mon PC en 64bits et sur d'autres PC également en 64 bits.

J'ai réinstallé entièrement l'OS==>idem,
Je compare ce qui peut être différent entre mon PC et l'autre PC et je ne vois aucune différence si ce n'est la version d'Office. Ma version est une 2019.
Mais ce fichier fonctionne sur d'autres PC avec des Office 2013, 2010 et 2016.
Pour ce qui est de la lecture du fichier mdb, j'ai bien les mêmes références sur les deux PC.

01.JPG 02.JPG 03.JPG
 

tanyssa

XLDnaute Nouveau
C'est surtout le premier qui m’intéresse car c'est pour récupérer les données dans un fichier access.
J'ai testé sur un autre PC avec le même processeur,j'ai le même problème. Il s'agit d'un I5 9500T.
Comme si ce processeur était incompatible avec ADO.
 

tatiak

XLDnaute Barbatruc
Bonjour à tous,

Un test possible : voici une démo (qui-ne-sert-à-rien) c'est un fichier excel qui lit dans une base Access. C'est codé en liaison tardive pour ne pas être bloqué par des références éventuellement manquantes.
On dézippe, on ouvre le xlsm, on clique sur le bouton 1. Si des données s'affichent c'est que ADO fonctionne sur le PC utilisé.

Pierre
 

Fichiers joints

tanyssa

XLDnaute Nouveau
Bonjour à tous,

Un test possible : voici une démo (qui-ne-sert-à-rien) c'est un fichier excel qui lit dans une base Access. C'est codé en liaison tardive pour ne pas être bloqué par des références éventuellement manquantes.
On dézippe, on ouvre le xlsm, on clique sur le bouton 1. Si des données s'affichent c'est que ADO fonctionne sur le PC utilisé.

Pierre
Merci, je vais tester tout ça...
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

=>tanyssa
Sur quel PC (et OS) et avec quelle version d'Office s'affiche le message d'erreur du message#1?
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

tanyssa
Si tu pouvais joindre le code VBA du module incriminé ainsi que tes déclarations des dll, on y verrait plus clair, non ?
 

tanyssa

XLDnaute Nouveau
VB:
Sub RecupBaseMois()
Application.ScreenUpdating = False
    Dim objField As ADODB.Field
    Dim rsData As ADODB.Recordset
    Dim lOffset As Long
    Dim szConnect As String
    Dim szSQL As String
    Dim j As Integer
    Dim y As Long
    Dim i As Long
 
    Chemin = ActiveWorkbook.Path
 
    i = Sheets("Param").Range("B2")
 
    If Sheets("Bordereau").Range("A2") = 0 Then
        If Sheets("Basemois").Cells(2, 1) = "" Then
            Sheets("Bordereau").Range("A1") = CDate(Sheets("Bdn").Cells(i, 2)) + 2
        Else
            Dim l As Integer
            l = Sheets("Param").Range("AM35") + 1
            Sheets("Bordereau").Range("A1") = CDate(Sheets("BaseMois").Cells(l, 1) + 1)
        End If
    End If
     
        Sheets("BaseMois").Range("A1:BH32").ClearContents
        j = Month(Sheets("Bordereau").Range("A2"))
        y = Year(Sheets("Bordereau").Range("A2"))
   
        szConnect = "Provider=Microsoft.jet.OLEDB.4.0;" & _
        "Data Source=" & Chemin & "\" & Base & ";" & _
        "Mode-Share Exclusive"
     
        szSQL = "select * from Datas where month(datejour)=" & j & " and year(datejour)=" & y
     
        If Not FileExists(Base) Then
            MsgBox "Le fichier Base est introuvable !", vbCritical, "Erreur critique"
            GoTo ErrorExit
        End If
     
        Set rsData = New ADODB.Recordset
       rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
     
        If Not rsData.EOF Then
            With Sheets("BaseMois").Range("A1")
                For Each objField In rsData.Fields
                    .Offset(0, lOffset).Value = objField.Name
                    lOffset = lOffset + 1
                Next objField
                .Resize(1, rsData.Fields.Count).Font.Bold = True
            End With
            Sheets("BaseMois").Range("A2").CopyFromRecordset rsData
            Sheets("BaseMois").UsedRange.EntireColumn.AutoFit
        Else
            GoTo ErrorExit
        End If
     
ErrorExit:
        rsData.Close
        Set rsData = Nothing
     
Application.ScreenUpdating = True
End Sub

Le code s'arrête en indiquant fournisseur mal installé ici :
Code:
rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Re

Pour l'autre message d'erreur, essaie ce que préconise dans ce fil Marcel32
 

tatiak

XLDnaute Barbatruc
Bonjour à tous,

En supposant que "Base" est bien définie quelque part et que la function FileExists existe également dans le code ailleurs, je propose le code modifié suivant :
VB:
Sub RecupBaseMois()
Dim Cnx As Object, Rst As Object
Dim lOffset As Long, y As Long, i As Long
Dim szConnect As String, szSQL As String, chemin As String
Dim j As Integer, l As Integer, k As Integer

    Application.ScreenUpdating = False
    chemin = ThisWorkbook.Path
 
    i = Sheets("Param").Range("B2")
 
    If Sheets("Bordereau").Range("A2") = 0 Then
        If Sheets("Basemois").Cells(2, 1) = "" Then
            Sheets("Bordereau").Range("A1") = CDate(Sheets("Bdn").Cells(i, 2)) + 2
        Else
            l = Sheets("Param").Range("AM35") + 1
            Sheets("Bordereau").Range("A1") = CDate(Sheets("BaseMois").Cells(l, 1) + 1)
        End If
    End If
    
    Sheets("BaseMois").Range("A1:BH32").ClearContents
    j = Month(Sheets("Bordereau").Range("A2"))
    y = Year(Sheets("Bordereau").Range("A2"))
  
    szConnect = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & chemin & "\" & Base
    szSQL = "SELECT * FROM Datas WHERE MONTH(datejour)=" & j & " AND YEAR(datejour)=" & y
    
    If Not FileExists(Base) Then
        MsgBox "Le fichier Base est introuvable !", vbCritical, "Erreur critique"
        GoTo ErrorExit
    End If
    
    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Open szConnect ' ou Cnx.Open szConnect, 0, 1, 1
    
    Set Rst = CreateObject("ADODB.Recordset")
    Rst.Open szSQL, Cnx, 3
    
    If Not Rst.RecordCount = 0 Then
        With Sheets("BaseMois")
            For k = 0 To Rst.Fields.Count - 1
                ActiveSheet.Cells(1, k + 1).Value = Rst.Fields(i).Name
            Next k
            .Range("A1").Resize(1, Rst.Fields.Count).Font.Bold = True
        End With
        Sheets("BaseMois").Range("A2").CopyFromRecordset Rst
        Sheets("BaseMois").UsedRange.EntireColumn.AutoFit
    End If
    
ErrorExit:
    Cnx.Close
    Set Cnx = Nothing
    Set Rst = Nothing
    Application.ScreenUpdating = True
End Sub
A tester ...
Pierre
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas