Word VBA open last saved .docm file in folder

[didijaba]

Hello,
I have trouble finding last saved .docm file in folder where Thisdocument is. It would have to be part of Word VBA. This is what I have so far.

Sub ExtractImages()   'gmaxey script from vbaexpress
    Dim strFileNameAndPath As String, strFilename As String, strName As String
    Dim strBasePath As String, strDate As String
    Dim strExtractionFolder As String, strImageName As String
    Dim lngIndex As Long
    Dim oRng As Word.Range
    Dim arrCaptions() As String

     'Store image caption names.  The paragraph immediately following the shape paragraph defines the image caption.
    ReDim arrCaptions(ActiveDocument.InlineShapes.Count - 1)
    For lngIndex = 1 To ActiveDocument.InlineShapes.Count
        Set oRng = ActiveDocument.InlineShapes(lngIndex).Range
        oRng.Collapse wdCollapseEnd
         'Move range to start of caption paragraph text.
        oRng.Move wdParagraph, 1
         'Extend range to end of paragraph.
        oRng.MoveEndUntil Cset:=Chr(13), Count:=wdForward
        arrCaptions(lngIndex - 1) = oRng.Text
    Next lngIndex
     
    strFileNameAndPath = ActiveDocument.FullName
     'Define folder for extracted images.
    
    
    'strBasePath = SpecialFolderPath & Application.PathSeparator
    strBasePath = ActiveDocument.Path & "\"
    
    strDate = Format(Now, "yyyy-mm-dd")
    strFilename = GetFileNameWithoutExtension(ActiveDocument.Name)
    strExtractionFolder = strDate & "_" & strFilename
     
     'Delete the folder if it exists.
    On Error Resume Next
     'Delete any files.
    Kill strBasePath & strExtractionFolder & "_files\*"
    RmDir strBasePath & strExtractionFolder & "_files"
    On Error GoTo 0
     
     'Save the current document.
    ActiveDocument.Save
     
     'Save document in HTML format.  This creates the "_files\" folder in the Extraction Folder.
    ActiveDocument.SaveAs2 Filename:=strBasePath & strExtractionFolder & ".html", FileFormat:=wdFormatFilteredHTML
     
    ActiveDocument.Close
     
    On Error Resume Next
     'Get rid of extraneous data files.  Keep only the images.
    Kill strBasePath & strExtractionFolder & ".html"
    Kill strBasePath & strExtractionFolder & "_files\*.xml"
    Kill strBasePath & strExtractionFolder & "_files\*.html"
    Kill strBasePath & strExtractionFolder & "_files\*.thmx"
    On Error GoTo 0
     
     'Rename image files.
    lngIndex = 0
    strName = Dir(strBasePath & strExtractionFolder & "_files\")
    While strName <> ""
         'Some characters are invalid in file names. A colon is invalid and could be used in the caption e.g., Screenshot 1: The Mona Lisa"
        strImageName = Replace(arrCaptions(lngIndex), ":", "-")
        Name strBasePath & strExtractionFolder & "_files\" & strName As strBasePath & strExtractionFolder & "_files\" & strImageName & ".png"
        strName = Dir()
        lngIndex = lngIndex + 1
    Wend
    Word.Documents.Open (strFileNameAndPath)
    Word.Application.Visible = True
    Word.Application.Activate
    Exit Sub

lbl_Exit:
    Exit Sub

End Sub
Function GetFileNameWithoutExtension(ByRef strFilename As String) As String
    On Error GoTo Err_NoExtension
    GetFileNameWithoutExtension = VBA.Left(strFilename, (InStrRev(strFilename, ".", -1, vbTextCompare) - 1))
lbl_Exit:
    Exit Function
Err_NoExtension:
    GetFileNameWithoutExtension = strFilename
    Resume lbl_Exit
End Function
Function SpecialFolderPath() As String
    Dim objWSHShell As Object
    Dim strSpecialFolderPath
     
    Set objWSHShell = CreateObject("WScript.Shell")
    SpecialFolderPath = objWSHShell.SpecialFolders("Desktop")
    Set objWSHShell = Nothing
lbl_Exit:
    Exit Function
End Function

 

[Macropod]

Your code doesn't appear to be looking for any documents, let alone a specific one.

 

[didijaba]

Thanks for your replay. My wish is to reopen document I saved as ActiveDocument (before saving as HTML format). I do not know how to address that document. I was thinking find last saved docm in folder but I have no working example of such script.

 

[Macropod]

It's still the ActiveDocument... All you need do is change the save format back to what it was originally. Alternatively, store the ActiveDocument.FullName string before saving as HTML. Then, after you've saved as HTML, close the ActiveDocument then re-open the one with the stored name.

 

[didijaba]

Sorry, I have tried different things but I can not get this code to work. I listened to your advise and saved activedocument.fullname but I do not know how to apply it. Here is what I have so far.

Sub ExtractImages()
    Dim strFileNameAndPath As String, strFilename As String, strName As String
    Dim strBasePath As String, strDate As String
    Dim strExtractionFolder As String, strImageName As String
    Dim lngIndex As Long
    Dim oRng As Word.Range
    Dim arrCaptions() As String
Application.ScreenUpdating = False

'************************************
ActiveDocument.Variables("FullName").Delete
'***********************************

     'Store image caption names.  The paragraph immediately following the shape paragraph defines the image caption.
    ReDim arrCaptions(ActiveDocument.InlineShapes.Count - 1)
    For lngIndex = 1 To ActiveDocument.InlineShapes.Count
        Set oRng = ActiveDocument.InlineShapes(lngIndex).Range
        oRng.Collapse wdCollapseEnd
         'Move range to start of caption paragraph text.
        oRng.Move wdParagraph, 1
         'Extend range to end of paragraph.
        oRng.MoveEndUntil Cset:=Chr(13), Count:=wdForward
        arrCaptions(lngIndex - 1) = oRng.Text
    Next lngIndex
     
    strFileNameAndPath = ActiveDocument.FullName
     'Define folder for extracted images.
    
    
    'strBasePath = SpecialFolderPath & Application.PathSeparator
    strBasePath = ActiveDocument.Path & "\"
    
    strDate = Format(Now, "yyyy-mm-dd")
    strFilename = GetFileNameWithoutExtension(ActiveDocument.Name)
    strExtractionFolder = strDate & "_" & strFilename
     
     'Delete the folder if it exists.
    On Error Resume Next
     'Delete any files.
    Kill strBasePath & strExtractionFolder & "_files\*"
    RmDir strBasePath & strExtractionFolder & "_files"
    On Error GoTo 0
     
 
    '************************************************* storing the ActiveDocument.FullName string before saving as HTML
    
    Dim fName As String
   fName = ActiveDocument.FullName
   ' Set contents of variable "fName" in a document using a document
   ' variable called "FullName".
   ActiveDocument.Variables.Add Name:="FullName", Value:=fName
   ' Retrieve the contents of the document variable.
   MsgBox ActiveDocument.Variables("FullName").Value   'Test 
    
       
    '*************************************************
        'Save the current document.
    ActiveDocument.Save
    
     'Save document in HTML format.  This creates the "_files\" folder in the Extraction Folder.
    ActiveDocument.SaveAs2 Filename:=strBasePath & strExtractionFolder & ".html", FileFormat:=wdFormatFilteredHTML
    ActiveDocument.Close

        'On Error Resume Next
     'Get rid of extraneous data files.  Keep only the images.
    Kill strBasePath & strExtractionFolder & ".html"
    Kill strBasePath & strExtractionFolder & "_files\*.xml"
    Kill strBasePath & strExtractionFolder & "_files\*.html"
    Kill strBasePath & strExtractionFolder & "_files\*.thmx"
    On Error GoTo 0
     
     'Rename image files.
    lngIndex = 0
    strName = Dir(strBasePath & strExtractionFolder & "_files\")
    While strName <> ""
         'Some characters are invalid in file names. A colon is invalid and could be used in the caption e.g., Screenshot 1: The Mona Lisa"
        strImageName = Replace(arrCaptions(lngIndex), ":", "-")
        Name strBasePath & strExtractionFolder & "_files\" & strName As strBasePath & strExtractionFolder & "_files\" & strImageName & ".png"
        strName = Dir()
        lngIndex = lngIndex + 1
    Wend
'********************************************************************

    Documents.Open(Filename:=ActiveDocument.Variables("FullName")).Open
    
'*********************************************************************
'   Word.Documents.Open (strFileNameAndPath)
    Word.Application.Visible = True
    Word.Application.Activate
    Exit Sub
Application.ScreenUpdating = True
lbl_Exit:
    Exit Sub
Application.ScreenUpdating = True
End Sub
Function GetFileNameWithoutExtension(ByRef strFilename As String) As String
    On Error GoTo Err_NoExtension
    GetFileNameWithoutExtension = VBA.Left(strFilename, (InStrRev(strFilename, ".", -1, vbTextCompare) - 1))
lbl_Exit:
    Exit Function
Err_NoExtension:
    GetFileNameWithoutExtension = strFilename
    Resume lbl_Exit
End Function
Function SpecialFolderPath() As String
    Dim objWSHShell As Object
    Dim strSpecialFolderPath
     
    Set objWSHShell = CreateObject("WScript.Shell")
    SpecialFolderPath = objWSHShell.SpecialFolders("Desktop")
    Set objWSHShell = Nothing
lbl_Exit:
    Exit Function
End Function

 

[Macropod]

What's with this code???:

'************************************
ActiveDocument.Variables("FullName").Delete
'***********************************
...
'************************************************* storing the ActiveDocument.FullName string before saving as HTML

Dim fName As String
fName = ActiveDocument.FullName
' Set contents of variable "fName" in a document using a document
' variable called "FullName".
ActiveDocument.Variables.Add Name:="FullName", Value:=fName
' Retrieve the contents of the document variable.
MsgBox ActiveDocument.Variables("FullName").Value 'Test


'*************************************************
...
'********************************************************************

    Documents.Open(FileName:=ActiveDocument.Variables("FullName")).Open
    
'*********************************************************************

It does nothing useful that I can see. After all, a document's full name is always whatever is in ActiveDocument.FullName and, if you want that to show in a document, all you need is a FILENAME field.

Since you're storing the document's full name in 'strFileNameAndPath', via 'strFileNameAndPath = ActiveDocument.FullName' all you need do is uncomment the 'Word.Documents.Open (strFileNameAndPath)' line...

 

[didijaba]

Thanks for your replay. When code is as you wrote before it only opens Word app but word document is not being reopen. I have uploaded doc if it helps (TEXT_V07.docm - Speedy Share - upload your files here).

 

[Macropod]

When code is as you wrote before it only opens Word app but word document is not being reopen.

That's probably because you're running the code from the active document. As soon as the code processes 'ActiveDocument.Close' it will stop running because the macro too has been closed. The simple solution is to not run the code from the active document.

 

[didijaba]

I have started macro from global template and it works . Thanks for your kind help