VBA 2010 omzetten naar VBA 2003 en 2007

[remcop1989]

Allereerst voor iedereen nog een gelukkig nieuwjaar!

Ik heb een stukje code geschreven voor Word 2010. Nu moet dit echter ook gaan draaien op een PC met Word 2003 en Word 2007.

Ik kom er helaas niet achter hoe dit omgezet moet worden.
Kan iemand mij hierbij helpen/ondersteunen/adviseren?

Dit is de code voor Word 2010:

Sub Convert_2_PDF()
    
    Dim XDocument As String
    Dim Xname As String
    Dim oWord As Word.Application
    
    'Let op vervang ook de extensies .docx en .doc
    
    If ActiveDocument.Path <> "" Then
            Xname = Strtran(Strtran((ActiveDocument.Name), ".docx", ""), ".doc", "") & ".pdf"
            Xname = UCase(Left(Xname, 1)) + Right(Xname, Len(Xname) - 1)
        
            XDocument = ActiveDocument.Path & "\" & Xname
          
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
            XDocument, ExportFormat:= _
            wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
            wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
            Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
            BitmapMissingFonts:=True, UseISO19005_1:=False
                        
            PDFdocument = ActiveDocument.Path & "\" & Xname
            ActiveDocument.FollowHyperlink PDFdocument
                        
            'sluit Word af
            Do
            Set oWord = GetObject(Class:="Word.Application")
            If Not oWord Is Nothing Then
                oWord.Quit False
                Set oWord = Nothing
            End If
            Loop Until oWord Is Nothing

    End If
   
End Sub

Function Strtran(Search As String, Find As String, Replace As String, Optional Start As Long, Optional HowMuch As Long) As String
    
    'Strtran Functie, afgeleid van Microsoft Foxpro
    
    Dim Begin%
    Dim Count%
    Dim CountRep%
    Dim Deel1$
    Dim Deel2$
    Dim Help$
    Dim LenFind%
    Dim LenHelp%
    Dim LenSearch%
    Dim Part1%
    Dim Part2%
    
    Help$ = Search                 ' HelpString
    Strtran = Help$                ' Returnwaarde functie

    If Find = Replace Then
        '
        ' Zoekstring is gelijk aan de tee vervangen string
        ' Verlaat de Functie
        '
        Exit Function
    End If
    
    LenFind% = Len(Find)           ' Lengte te vervangen str$
                                    ' Indien 0, Vervang met space(0)
    Count% = 0                      ' Aantal keren dat de Find$ gevonden is.
    CountRep% = 0                   ' Aantal keren dat Find$ vervangen is.

    LenSearch% = Len(Help$)         ' Lengte te doorzoeken String
    
    Begin% = 1                      ' Startwaarde met zoeken Find$
    
    Do
        '
        ' Lus om de string die doorzocht moet worden te ontleden.
        '

        Begin% = InStr(Begin%, Help$, Find)
        LenHelp% = Len(Help$)
        
        If Begin% > 0 Then
            '
            ' De te zoeken string komt voor
            '
            
            Count% = Count% + 1

            If Count% >= Start Or Start = 0 Then
                '
                ' Indien Start%>0 dan wordt pas vanaf de Start%-waarde
                ' begonnen met het vervangen.
                '
                
                If CountRep% < HowMuch Or HowMuch = 0 Then
                    '
                    ' Indien HowMuch%>0 dan maximaal HowMuch% keer
                    ' Find$ laten vervangen door replace$
                    '
                    CountRep% = CountRep% + 1
                    
                    Part1% = Begin% - 1
            
                    If Part1% < 1 Then
                        Deel1$ = ""
                    Else
                        Deel1$ = Left(Help$, Part1%)
                    End If
            
                    Part2% = LenHelp% - Begin% - LenFind% + 1

                    If Part2% < 1 Then
                        Deel2$ = ""
                    Else
                        Deel2$ = Right(Help$, Part2%)
                    End If
                    Help$ = Deel1$ + Replace + Deel2$
                Else
                    Exit Do
                End If
            Else
                Begin% = Begin% + 1
            End If
        Else
            '
            ' Niets meer gevonden verlaat lus
            '
            Exit Do
        End If
        
    Loop

    '
    ' Geef de opgebouwde string terug
    '
    Strtran = Help$

End Function

Alvast bedankt!

 

[snb]

de opdracht opslaan als PDF komt helemaal niet voor in Word 2003. Dat gaat zo dus nooit lukken.

Die strtran funktie is een onnodig moeilijke manier om in de scripting.filesystemobject bibliotheek ingebouwde methodes na te bootsen:

msgbox createobject("scripting.filesystemobject").getbasename(thisworkbook.name)

Kijk per ongeluk ook eens hier:

http://www.snb-vba.eu/VBA_Bestanden.html#L2

 

[remcop1989]

Hartelijk dank voor het snelle antwoord.

Hoe kan dit het beste gedaan worden dan?

 

[snb]

De 2003 versie opwaarderen naar minimaal 2007.

 

[remcop1989]

En een oplossing die niet uitgaat van versie 2007....?

 

[OctaFish]

Zoals snb al aangaf: Word 2003 kent geen optie om op te slaan als 2003. Dan kun je lang zoeken, maar gaat het heel lastig worden. Ik heb nog wel een linkje naar een database waarin een pdf gemaakt wordt met een eigen functie, die je misschien kunt overnemen. Ik heb 'm ooit getest in een Access 2003 db en hij werkt, maar de kwaliteit van de pdf was niet geweldig. Maar beter als niks natuurlijk.
Beter is waarschijnlijk om het document af te drukken naar een (gratis) pdf printer als CutePDF. Of alternatieven daarvan.