Nieuwe module importeren

[zwaanser]

Hallo beste VBA experts!
Ik kom niet verder met een code die ik aan het samensprokkelen ben.
Ik wil in een bestaand excel formulier, welke door mijzelf op vba niveau beveiligd is een nieuwe module inmporteren.
Dit lukt mij enkel als ik de code laat lopen met onderbrekingspunten. Dus als ik alles regel per regel overloop lukt het wel.
Echter als de code loopt zonder onderbrekingspunten werkt het niet.
Iemand een idee hoe dit komt, of hoe ik dit kan verhelpen?

Werking:
Eerst map selecteren van de documenten waar ik de module wil in importeren.
Vervolgens de map selecteren waarin de module staat.

Voorbeeld bestand in bijlage.

Hieronder de code:

Sub CmdImportModule_Click()
Dim DIRECTORY As String, FILENAME As String, SHEET As Worksheet, i As Integer, j As Integer, WACHT As String
Dim ONTVANGER As String, BESTANDEN As String
Dim xFileDialog As FileDialog
Dim WS As Worksheet

Application.ScreenUpdating = False
On Error Resume Next
'MAP SELECTEREN VAN DE AAN TE PASSEN DOCUMENTEN
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Kies een map met de aant te passen documenten."
    If xFileDialog.Show = -1 Then
        DIRECTORY = xFileDialog.SelectedItems(1)
        Sheets("STARTBLAD").Range("C11").Value = DIRECTORY
    End If
    If DIRECTORY = "" Then Exit Sub
'MAP SELECTEREN VAN DE OP TE HALEN BESTANDEN (USERFORMS of MODULES)
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Kies de map met de in te voegen bestanden."
    If xFileDialog.Show = -1 Then
        BESTANDEN = xFileDialog.SelectedItems(1)
        Sheets("STARTBLAD").Range("C12").Value = BESTANDEN
    End If
    If BESTANDEN = "" Then Exit Sub
    
'CODE UITVOEREN BIJ ALLE EXCEL BESTANDEN IN DE GESELECTEERDE MAP
FILENAME = Dir(DIRECTORY & "\*.xls")
ONTVANGER = DIRECTORY & "\" & FILENAME

Do While FILENAME <> ""
    Workbooks.Open (DIRECTORY & "\" & FILENAME)
    MsgBox (DIRECTORY & "\" & FILENAME)
    'PASWOORD ERAF HALEN
    Const conPW As String = "PASWOORD" '=PASWOORD
    Call SendKeys("%(d)P" & "VBAProject" & ActiveWorkbook.Name & "{ENTER}" & conPW & "{ENTER}", True)
    'MODULE IMPORTEREN
    Workbooks(FILENAME).VBProject.VBComponents.Import BESTANDEN & "\Beveiliging.bas"
    Workbooks(FILENAME).Save
    Workbooks(FILENAME).Close
FILENAME = Dir()
Loop
End Sub

 

[edmoor]

Ik denk dat het dan te snel gaat en de SendKeys opdracht geen tijd heeft z'n werk af te maken.
Zet dan eens dit in de plaats van het importeren:

Application.OnTime Now() + TimeValue("00:00:02"), DoImport

En dit in een module:

Public FILENAME As String
Public BESTANDEN As String

Sub DoImport()
    [COLOR="#008000"]'MODULE IMPORTEREN[/COLOR]
    Workbooks(FILENAME).VBProject.VBComponents.Import BESTANDEN & "\Beveiliging.bas"
    Workbooks(FILENAME).Save
    Workbooks(FILENAME).Close
End Sub

Die Dim FILENAME en Dim BESTANDEN dan wel uit je eigen code verwijderen.
Zo krijgt SendKeys 2 seconden de tijd om z'n taak te doen voordat het importeren begint.

 

[zwaanser]

Hoi Edmoor,
bedankt voor de snelle reactie. Ik krijg echter een compileerfout waar vba zegt dat er een function of variabele verwacht wordt.
Waarbij de "DoImport" achter Application.OnTime Now() + TimeValue("00:00:02") donkerblauw oplicht. Wellicht zit het hier ergens in?

 

[edmoor]

Sorry, dat moet tussen aanhalingstekens:

Application.OnTime Now() + TimeValue("00:00:02"), "DoImport"

 

[zwaanser]

Nu krijg ik volgende melding :
"Macro kan niet worden uitgevoerd. De macro is wellicht niet beschikbaar in dit werkblad of alle macro's zijn mogelijk uitgeschakeld."
Macro's zijn in het vertrouwenscentrum ingeschakeld, dus daar ligt het niet aan.

 

[edmoor]

Heb je wel die DoImport in een Module gezet?

 

[zwaanser]

Ik heb deze in een module gezet nu, maar daar blijft de FILENAME leeg.
Heb het bestand erbij gevoegd.

 

[edmoor]

Je hebt dit niet bovenin de module gezet:

Public FILENAME As String
Public BESTANDEN As String

Haal dat achter het werkblad weg.

 

[zwaanser]

Het blijft leeg. Zie bijlage.

 

[edmoor]

Zo is het goed.
Waarom het nu leeg blijft kan ik niet testen en zal je zelf in debug mode na moeten gaan.

 

[zwaanser]

Toch heel erg bedankt, ik ga het verder bekijken.

 

[zwaanser]

Ik denk dat het probleem bij onderstaand ligt :

Application.OnTime Now() + TimeValue("00:00:10"), "DoImport"

Volgens mij wordt die macro inderdaad na 10sec opgestart, maar de rest loopt gewoon door terwijl de bedoeling is dat alles even in "hold" wordt gezet om de module te kunnen importeren.
En dus is de FILENAME leeg omdat de macro al op zijn eind zit.
Klopt mijn redenering of zit ik er helemaal naast?

 

[edmoor]

Ik denk dat dat helemaal klopt.
Dat zou je op kunnen vangen op de manier zoals in dit document (Ongetest), dus zou weleens helemaal mis kunnen gaan

 

[snb]

Heb je dit al geprobeerd ?

Sub M_snb()
  c00 = "G:\OF\"
  c01 = Dir(c00 & "*.bas")
    
  with ThisWorkbook
     .VBProject.VBComponents.Import c01
    .close -1
  end with
End Sub

 

[zwaanser]

Hoi Snb
Is deze syntax niet hetzelfde ongeveer, buiten ThisWorkbook, bij mij gebruik ik de gehele naam en path?
Of geeft dit een verschil?

 

[zwaanser]

Hey EdMoor
Het draait niet helemaal soepel, het blijft in een loop zitten.

 

[edmoor]

Ja, dat had ik al verwacht.
Ik denk dat je het heel anders in elkaar moet steken.
De tip van snb is daarin een ook een goede.

 

[zwaanser]

Daar zal ik mijn kop nog eens over moeten breken. Ik vrees dat het op niet veel andere manieren gaat lukken.
Lijkt mij toch logisch: Excel bestand openen/gekend paswoord eraf/module importeren/bestand saven en sluiten

 

[snb]

Ik heb de code nog iets aangepast/uitgebreid.
Het testen laat ik graag aan jou over.

 

[zwaanser]

Ik wil het dolgraag testen Snb, maar ik zie geen bijlage ;-)