Macro in macro

[taktix]

Hoi,

In bijgevoegd bestand (Juli.xlsm) zit een macro. Deze werkt zoals ik wil (mailt een pdf naar een e-mailadres). Daar heb ik dan ook een Augustus.xlsm en een September.xlsm van. Deze zijn hetzelfde als Juli.xlsm maar dan met andere gegevens. Nu wil ik in het andere bestand (Overzicht.xlsm) een macro met een loop waardoor elk bestand in kolom B langsgegaan wordt en daarin de macro wordt geactiveerd zodat een pdf wordt gemaild. Het werkt niet zoals ik het nu heb. Iemand een idee hoe wel?

Bedankt!!

Dit is de macro die ik heb geprobeerd:

Sub MailPDFs()

    ' Declare
    Dim rngActivecell, rngColumn1, rngColumn2 As Range
    Dim strCurrentdir As String
    Dim wbInvulformulier As Workbook
    Dim strDatum As String
    Dim strWorkbook As String
    Dim oWb As Workbook
    Dim oSht As Worksheet
    
    ' Current working directory
    strCurrentdir = ActiveWorkbook.Path & "\"
    strWorkbook = naamWorkbook & ".xlsm"
    
    ' Loop
    Set rngActivecell = rngColumn1.Offset(1, 0)
    rngActivecell.Select
    
    Do
        ' Open workbook
        strWorkbook = rngActivecell.Offset(0, -1)
        Set oWb = Workbooks.Open(strCurrentdir & strWorkbook)
        If IsEmpty(oWb) Then
            MsgBox "Kan de excel, genaamd " & rngColumn1.Value & " ,niet vinden. Ik stop ermee."
            GoTo exit_command
        End If
    
Application.Run "Knop2_Klikken"

        ' Volgende waarde
        oWb.Save
        oWb.Close
        Set rngActivecell = rngActivecell.Offset(1, 0)
        
    Loop Until IsEmpty(rngActivecell)

exit_command:
End Sub

 

[Wigi]

Mits geordend en weloverwogen werken, is dit zeker te doen. Code in Overzicht.xlsm:

Sub MailPDFs()

    Dim rngCell As Range
    Dim oWb As Workbook
    
    For Each rngCell In ThisWorkbook.Sheets("Blad1").Range("B4:B6")
        On Error Resume Next
        Set oWb = Workbooks.Open(ActiveWorkbook.Path & "\" & rngCell & ".xlsm")
        If Err.Number Then
            Err.Clear
            MsgBox "Kan het Excelbestand genaamd " & rngCell & ".xlsm" & " niet openen. Ik stop ermee.", vbCritical, "Status"
            Exit Sub
        Else
            Application.Run oWb.Name & "!MijnProcedure"
            oWb.Close 0
        End If
    Next

End Sub

Mijn testcode in bestand Juli.xlsm:

Sub MijnProcedure()
    MsgBox ActiveWorkbook.Name
End Sub

Dit zal jou toelaten om uit te breiden met de PDF en Outlook code.

Wigi

 

[taktix]

U zijt geweldig!

 

[taktix]

Toch nog 1 vraag. Als ik een bestandsnaam heb die bijvoorbeeld "Juni, eerst helft" heet dan pakt ie hem niet. Is dit op te lossen in de code (dat heb ik het liefst) of moet ik dan de bestandsnamen aanpassen, doordat er bijvoorbeeld geen komma's in kunnen staan. Hij opent het bestand wel, maar voert de macro niet uit heb ik het idee.

Bedankt weer!

 

[Wigi]

Niet getest, maar denk wel dat dit werkt:

Application.Run "'" & oWb.Name & "'!MijnProcedure"

 

[taktix]

Nee, hij voert dan de andere macro niet uit.

 

[Wigi]

Toch wel, althans als je de quotes juist toepast.

Post de code van die procedure (MailPDFs) hier, zodat we kunnen zien wat er mis gaat.

 

[taktix]

Dit is de code van MailPDFs:

Sub MailPDFs()

    Dim rngCell As Range
    Dim oWb As Workbook
    
    For Each rngCell In ThisWorkbook.Sheets("Invulformulier").Range("B4:B22")
        On Error Resume Next
        Set oWb = Workbooks.Open(ActiveWorkbook.Path & "\" & rngCell & ".xlsm")
        If Err.Number Then
            Err.Clear
            MsgBox "Kan het Excelbestand genaamd " & rngCell & ".xlsm" & " niet openen.", vbCritical, "Status"
            Exit Sub
        Else
            Application.Run oWb.Name & "!Afbeelding2_Klikken"
            oWb.Close 0
        End If
    Next

End Sub

 

[Wigi]

Zoals ik dus al schreef, je hebt de quotes in de aanroep van de andere procedure, niet geplaatst.

 

[taktix]

Hoe bedoel je dat precies?

 

[Wigi]

Je ziet mijn code toch in post #5 van deze topic?

 

[taktix]

Ja, klopt, maar ook als dat er bij staat lukt het niet. Dan worden ze alleen geopend en gesloten.

Sub MailPDFs()

    Dim rngCell As Range
    Dim oWb As Workbook
    
    For Each rngCell In ThisWorkbook.Sheets("Invulformulier").Range("B4:B22")
        On Error Resume Next
        Set oWb = Workbooks.Open(ActiveWorkbook.Path & "\" & rngCell & ".xlsm")
        If Err.Number Then
            Err.Clear
            MsgBox "Kan het Excelbestand genaamd " & rngCell & ".xlsm" & " niet openen.", vbCritical, "Status"
            Exit Sub
        Else
            Application.Run "'" & oWb.Name & "!Afbeelding2_Klikken"
            oWb.Close 0
        End If
    Next

End Sub

 

[Wigi]

Taktix,

U bent altijd wel snel met reageren, maar zelf op onderzoek gaan is er denk ik ook niet echt bij bij u.

Je opent in uw code dus een single quote en sluit die niet af - wat is de logica daarvan? In post #5 heb ik dat bij mij alleszins wel gedaan.

Ook is het interessant om geen code te hebben in een Afbeelding_Klikken macro e.d., enkel de aanroep naar een algemene procedure (in een module).
Deze procedure kan je ook makkelijker aanspreken in een procedure zoals MailPDFs, in vgl met die "Klikken" macro.

 

[taktix]

Klopt. Keek er steeds overheen. Begreep het nut van de single quote ook niet. Het werkt inderdaad wel. Excuses!! Bedankt voor je hulp! Super!

 

[Wigi]

Het lukte niet op de manier die u beschreef.

Hoe bedoel je? Met single quote werkt het toch - dat schrijf je zelf.