Cuadro de lista con documentos de Word abiertos

Vba

En este ejemplo, el cuadro de lista para mostrar documentos de Word se denomina lstWordDocuments. Personalice su código en consecuencia.

'*************** Code Start ***********************************************
' Purpose  : code behind a form to change RowSource of a listbox
'              with names of open Word documents
'              Select the active document
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'------------------------------------------------------------------------------
Function ListOpenDocuments() As Boolean 
's4p 220807, 221210
   'CALLs
   '  lstWordDocuments_reset  '----------- customize
   
   'GLOBAL VARIABLES
   '  goWord -- Word application
   '			early binding: as Word.Application
   '			late binding: as Object
   '  goDoc  -- active Word document
      '			early binding: as Word.Document
   '			late binding: as Object
   'MODULE VARIABLE
   '  moDoc  -- Word.Document or Object used for looping
   
   ListOpenDocuments = False 
   
   Dim sActiveDocumentName As String 
   Dim sList As String 
   Dim sListboxControlname As String 
   
   sListboxControlname =  "lstWordDocuments" ' --- customize
      
   On Error Resume Next 
   If goWord Is Nothing Then 
      Set goWord = GetObject(, "Word.Application") 
   End If 
   On Error GoTo Proc_Err 
   If goWord Is Nothing Then 
      MsgBox  "Word isn't open",, "Can't list documents"
      GoTo Proc_Exit 
   End If 
   
   sList =  ""
   sActiveDocumentName =  ""

   With goWord 
      
      If .Documents.Count > 0 Then 
         Set goDoc = .ActiveDocument 
         sActiveDocumentName = goDoc.Name 
         For Each moDoc In .Documents 
            With moDoc 
               sList = sList &  """" & .Name &  """;" _ 
                  &  """" & .FullName &  """;"
            End With 
         Next moDoc 
      Else 
         Set goDoc = Nothing 
         Call lstWordDocuments_reset  ' --- customize -- clear listbox
         MsgBox  "No documents open" _ 
            ,, "Can't list documents"
         GoTo Proc_Exit 
      End If 
   End With 
   
   With Me.Controls(sListboxControlname) 
      .RowSource = Left(sList,Len(sList) - 1) 
      If Nz(.Value, "")  sActiveDocumentName Then 
         .Value = sActiveDocumentName 
      End If 
      .Requery 
   End With 
   
   ListOpenDocuments = True 
   
Proc_Exit: 
   On Error Resume Next 
   Exit Function 
  
Proc_Err: 
   MsgBox Err.Description _ 
       ,, "ERROR " & Err.Number _ 
        &  "   ListOpenDocuments"

   Resume Proc_Exit 
   Resume 
End Function 

Private Sub lstWordDocuments_reset()  '--------- customize for your listbox name
'221108 s4p
   With Me.lstWordDocuments 
      .RowSource =  ""
      .Value = Null 
   End With 
End Sub 
'*************** Code End *****************************************************

El código se generó con colores utilizando el complemento gratuito Color Code para Access.