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.
 

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...
 

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
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    44.7 KB · Affichages: 37

Staple1600

XLDnaute Barbatruc
Re

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

tanyssa

XLDnaute Nouveau
C'est parfait, ça fonctionne nickel pour aller chercher les données
Je ne voudrais pas abuser mais j'ai essayé pour écrire et je bloque, je te montre mon code pour écrire qui fonctionne sur les autres PC mais pas sur celui en question :

VB:
Sub Insert()
Application.ScreenUpdating = False

    '------------Déclarations des variables------------------
    Dim DateJour As Long, Restaurant As Double, Bar As Double, Couverts As Integer, Offerts As Integer
    etc...
    
    
    
    chemin = ActiveWorkbook.Path
    
    
    Dim objCommand As ADODB.Command
    Dim rsData As ADODB.Recordset
    Dim lRecordsAffected As Long
    Dim szConnect As String
    
    On Error GoTo ErrorHandler
      
      
        Sheets("DonneesBordereau").Select
        Sheets("DonneesBordereau").Cells(2, 1).Select
        DateJour = ActiveCell
        Restaurant = ActiveCell.Offset(0, 1)
        etc...
      
        szConnect = "Provider=Microsoft.jet.OLEDB.4.0;" & _
        "Data Source=" & chemin & "\" & Base & ";" & _
        "Mode-Share Exclusive"
        
        If Not FileExists(Base) Then
            MsgBox "Le fichier Base.mdb est introuvable !", vbCritical, "Erreur critique !"
            GoTo ErrorExit
        End If
        
        Set objCommand = New ADODB.Command
        objCommand.ActiveConnection = szConnect
    
        
        objCommand.CommandText = "INSERT INTO Datas(DateJour,Restaurant,Bar,Couverts,Offerts,Cinema,BarMAS,Cigarettes,Animation" & _
        ",Boule,PbBoule,EntreesBoule,Roulette,PbRoulette,BJ,PbBJ,EntreesJeux,CSG,MAS,PbMAS,EntreesMAS,Orph,Erreurs,DropMAS,DropRoulette,DropBoule" & _
        ",Comptee,H,F,Glaces,ChqMAS,CBMAS,ChqJeux,CBJeux,Positifs,Negatifs,BouleFerme,JeuxFerme,OrphJeux,OrphBoule,Location,Billeterie,ChequesBar,CBBar" & _
        ",ChequesResto,CBResto,TicketsResto,OffertsResto,OffertsBar,OffertsBarMAS,Banquet, PMU, PMU_Paris, TITOfin, TITOdebut, Coupons, fdj, ErreursGJ" & _
        ", RAE, Forfaits_MAS, TITOSexp, PbRAE, BJE)" & _
        "VALUES(" & DateJour & "," & Restaurant & "," & Bar & "," & Couverts & "," & Offerts & "," & Cinema & _
        "," & BarMAS & "," & Cigarettes & "," & Animation & "," & Boule & "," & PbBoule & "," & EntreesBoule & _
        "," & Roulette & "," & PbRoulette & "," & BJ & "," & PbBJ & "," & EntreesJeux & "," & CSG & "," & MAS & _
        "," & pbMAS & "," & EntreesMAS & "," & Orph & "," & Erreurs & "," & DropMAS & "," & DropRoulette & "," & _
        DropBoule & "," & Comptee & "," & H & "," & F & "," & Glaces & "," & ChqMAS & "," & CBMAS & "," & ChqJeux & "," & _
        CBJeux & "," & Positifs & "," & Negatifs & "," & BouleFerme & "," & JeuxFerme & "," & OrphJeux & "," & OrphBoule & "," & Location & "," & _
        Billeterie & "," & ChequesBar & "," & CBBar & "," & ChequesResto & "," & CBResto & "," & TicketsResto & "," & OffertsResto & "," & _
        OffertsBar & "," & OffertsBarMAS & "," & Banquet & "," & PMU & "," & PMU_Paris & "," & titofin & "," & TITOdebut & "," & coupons & "," & _
        FDJ & "," & ErreursGJ & "," & RAE & "," & Forfaits_MAS & "," & TITOSexp & "," & PbRAE & "," & BJE & ");"
    
        objCommand.Execute RecordsAffected:=lRecordsAffected, Options:=adCmdText
        PasErreur = 1
    
    If lRecordsAffected <> 1 Then Err.Raise Number:=vbObjectError + 1024, Description:="Erreur d'execution de l'instruction INSERT."
    
ErrorExit:
    Set objCommand = Nothing
    Set rsData = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ErrorExit
Application.ScreenUpdating = True
End Sub
 

tanyssa

XLDnaute Nouveau
Thanks a lot, c'est tout bon pour moi.
C'est un truc que j'avais fait il y a plus de 10 ans, je m’étais mis dans le bouquin adodb mais j'ai tout oublié...
Je voulais faire cette application sous Windev, la connexion à une base est beaucoup plus simple mais cela ne s'est pas fait...
 

Benoit2113

XLDnaute Nouveau
Bonjour,
Je ne vois que les remerciements et les messages préliminaires à ce qui semble être une solution.
Si jamais l'auteur repasse par ici, serait-il possible d'indiquer ce qu'il fallait faire ? J'ai ce problème mais du mal à trouver une solution via Google.
 

Discussions similaires

Réponses
2
Affichages
235
Réponses
9
Affichages
117

Statistiques des forums

Discussions
311 720
Messages
2 081 902
Membres
101 834
dernier inscrit
Jeremy06510