Impossible d'importer un module en VBA

Arpette

XLDnaute Impliqué
Bonsoir à toutes et à tous,
j'ai un message d'erreur sur la ligne #Set VBProj = wb.VBProject# Erreur 1004 la méthode a échoué.
PS : je ne vois plus les balises

Voici le code complet :
Sub imp_module()
Dim nf%, fbas$, f$
Dim wb As Workbook
Dim i&
Dim VBProj As Object
Dim oldMod As Object

Rep = "F:\Trames\Module\"
fbas = Rep & "Module3.bas"
Application.ScreenUpdating = False
Application.EnableEvents = False

f = Dir(Rep & "*.xls")
Do While f <> "" 'boucle sur les fichiers du répertoire
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(Rep & f) 'ouvre le fichier
Set VBProj = wb.VBProject
Set oldMod = ActiveWorkbook.VBProject.VBComponents("module3")
ActiveWorkbook.VBProject.VBComponents.Remove oldMod
Application.VBE.ActiveVBProject.VBComponents.Import (fbas)
On Error GoTo 0
Set VBProj = Nothing
Set CodeMod = Nothing
wb.Close True
End If
f = Dir()
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Merci de votre aide
@+
 

BrunoM45

XLDnaute Barbatruc
Bonjour à tous, bonjour @job75

Je déterre ce sujet de 2016, désolé, mais je rencontre le problème avec O365

Comme je veux importer du code dans ThisWorkbook, je ne peux pas utiliser l'import mais AddFromFile

Voici un extrait de mon code
La variable sPathCodes est OK
Le fichier existe bien
J'ai bien activé : Accès approuvé au code VBA

VB:
    ' Ajouter le code de ThisWorkbook
    With Wbk.VBProject.VBComponents("ThisWorkbook")
      .CodeModule.AddFromFile (sPathCodes & "CodeThisWBK.txt")
      If Err.Number <> 0 Then
        MsgBox "Impossible de trouver le fichier :" & vbCr _
        & sPathCodes & "CodeThisWBK.txt", vbCritical, "OUPS..."
        Err.Clear
        Exit Sub
      End If
    End With

En revanche j'ai l'erreur 1004 :eek::confused: une idée ?

Merci d'avance.
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Bonjour à tous

Sinon, j'ai une vieille routine qui fonctionne, mais il faudra tester.

VB:
Sub A_A_Copy_VB_Img_In_Thisworkbook()
'attention sur le fichier .txt, rajouter une ligne au début vierge, sinon, il manque une ligne.
'On Error Resume Next
Workbooks(ActiveWorkbook.Name).Activate
DoEvents
Workbooks(ActiveWorkbook.Name).Activate
iajcode = Workbooks(ActiveWorkbook.Name).VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
If iajcode > 0 Then Exit Sub
Close
'Open pathname For mode [Access access] [lock] As [#]filenumber [Len=reclength]
Open "C:\_VBA\Test.txt" For Input As #1
i = 1
With ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule
Line Input #1, ligne$
While EOF(1) <> True
Line Input #1, ligne$
.InsertLines i, ligne$: i = i + 1
Wend
End With
Close
End Sub
 

Discussions similaires

Haut Bas