Search code examples
vbams-publisher

Publisher VBA to save as image


I've developed the following code to save all publisher files in the current directory as an image, however it seems to take a long time to run through. Also, I can't figure out a way to exclude the current file that the macro is running from. Anyone got any ideas?

 Sub Looptest()

      Dim MyFile As String, Sep As String
      Dim objPub As Object
      Set objPub = CreateObject("Publisher.Application")
      Dim folder As String
      folder = CurDir()
    If Len(Dir(folder & "\" & "jpg", vbDirectory)) = 0 Then
        MkDir (folder & "\" & "jpg")
    End If


       Sep = Application.PathSeparator

      If Sep = "\" Then
         ' Windows platform search syntax.
         MyFile = Dir(CurDir() & Sep & "*.pub")

      Else

          MyFile = Dir("", MacID("XLS5"))
      End If

      ' Starts the loop, which will continue until there are no more files
      ' found.


      Do While MyFile <> ""
    'If MyFile = "macro.pub" Then
    'GoTo ContinueLoop
    'End If

    Dim pubApp As Publisher.Application
    Dim pubDoc As Publisher.Document
    Dim folder2 As String
    folder2 = CurDir() & Sep & MyFile


    Set pubApp = New Publisher.Application

    pubApp.Open folder2
    'pubApp.ActiveWindow.Visible = True
    num = folder2
    pubApp.ActiveDocument.Pages(1).SaveAsPicture CurDir() & Sep & "jpg" & "\" & MyFile & ".jpg"
    pubApp.Quit
             MyFile = Dir()
    'ContinueLoop:
          Loop

       End Sub

I've commented out my attempt at skipping the file (called Macro.pub in this instance), as it just seemed to stall and not go anywhere.

Any help would be greatly appreciated!

-Cr1kk0


Solution

  • Assuming your code is correct in all other respects, this might do the trick

    If MyFile = ActiveDocument.FullName Then
        GoTo ContinueLoop
    End If
    

    I'm guessing your check fails because you're comparing a short file name to a full file name. (You could also just hardcode the entire path to macro.pub)