Check Word document open

Status
Niet open voor verdere reacties.
D

DutchOirs

Gebruiker
Lid geworden
30 sep 2009
Berichten
720
Goedemorgen allen,

Zoek een mogelijkheid om vanuit een Excel-file te checken of een bepaald Word-file al open is.

Zie een en ander voorbijkomen, maar niet DE oplossing

Code: 
Sub CopyRTFDocToTemp()
 WordApp dimmen als object
 
 
 WordApp instellen = CreateObject("Word.Application")
 'Op fout GoTo Errhandler
 
 Met WordApp
 'Controleer of het bestand al is geopend, als dat het is, omzeilt u '. Documents.Open bestandsnaam:=strpathfile", en activeer in plaats daarvan het bestand
 
 Zo niet IsFileLocked (strpathfile) Dan
 . Documents.Open bestandsnaam:=strpathfile
 Anders
 
 Documenten(strpathfile). Activeren
 Beëindigen als
 . ActiveDocument.Selecteren
 . Selectie.Kopiëren
 
 Eindig met
 
 ActiveSheet.Range("A1"). Selecteren
 ActiveSheet.Plakken
 
 Met WordApp
 . ActiveDocument.Sluiten
 Eindig met
 
 WordApp.Quit
 WordApp instellen = Niets
 CopyDataFromTemp aanroepen
 
 Sub afsluiten
 
"Errhandler:
' Met WordApp
' . ActiveDocument.Sluiten
' Eindig met
' Oproep opnieuw opstarten
 
Sub beëindigen
https://www.ozgrid.com/forum/index....t-open-if-it-s-already-open-just-activate-it/

Gaat er alleen om om te checken of dat document (Word) al open is om te voorkomen dat hij weer geopend wordt.

Already Thanks
 
Dat kan met deze functie die ik er zelf ook voor gebruik:
Code: 
Function FileInWordOpen(DokName As String) As Boolean
    Dim wd As Word.Application
    Dim Wdoc As Word.Document
    Dim i As Long, s As String
    
    On Local Error Resume Next
    Set wd = GetObject(, "Word.Application")
    On Error GoTo NO_WORD_FOUND
    If wd Is Nothing Then
        FileInWordOpen = False
    End If
    
    For i = 1 To wd.Documents.Count
        s = wd.Documents(i)
        If InStr(DokName, s) <> 0 Then
            FileInWordOpen = True
            Exit Function
        End If
    Next
    
NO_WORD_FOUND:
     FileInWordOpen = False
End Function

Die gebruik je bijvoorbeeld als volgt:
Code: 
Sub Doctest()
    Dim Wdoc As String
    
    Wdoc = "Nieuwsbrief.docx"
    If FileInWordOpen(Wdoc) Then
        MsgBox "Het bestand " & Wdoc & " is open in Word"
    Else
        MsgBox "Het bestand " & Wdoc & " is niet open in Word"
    End If
End Sub
 
Laatst bewerkt:
Goedemiddag Edmoor,

Mooi, even aan het testen maar loopt tegen het volgende probleem op:

Compileerfoeut: Dim wd as Word.application komt niet voor, kan wel alleen application gebruiken.
Maar bij Dim wdoc as Word.document zelfde fenomeen, maar hier heb ik geen oplossing voor?

Gebruik excel 2003

oh wacht wel iets gevonden. als ik Wdoc niet dimensioneerd werkt ie wel..

even verder testen
 
Laatst bewerkt:
Voeg in de VBA Editor > Extra > Verwijzen de Microsoft Word Object Library toe.
Dus even opzoeken in de grote lijst.
 

Bijlagen

  • MW.png
    MW.png
    20,2 KB · Weergaven: 17
komt helaas niet voor daar

niets over Word

o wacht onder Microsoft Word 11.0 Object Library gevonden.
Dat zal hem wezen :)
 
Laatst bewerkt:
Dat kan niet.
 
gelukt thanks Edmoor
zat onder de W te kijken :-(
Moest dus M zijn lolz dom dom

Maar het werkt even verder testen

Perfect thanks
 
Laatst bewerkt:
Goedenavond Edmoor,

Heb nog iets gevonden.

Systeem werkt nu (nog niet klaar) Als hij opstart kijkt hij of betreffende Word document al geopend is: zo ja, slaat hij het openen over, zo nee dan opent hij desbetreffend Word (basis) document.
Tot dusver gaat het goed.
Heb basis Word document iets aangepast en een tabel van 51 regels gemaakt.
Ook hier gaat goed, alleen loop tegen het volgende ding op:

Regel 11 zet hij 2 punten neer terwijl dit er maar 1 zou mogen zijn?

Rara? heeft dit te maken met 1 en 11? zie rode deel.
Code: 
Private Sub Uitvoering()
  Dim Comtext As String, wordapp, WrdBestand As String, C As Comment, VarComment As String, selectedcell, Word, RijNummer As Integer
  Dim cl As Range, i As Integer, pos1(10) As Integer, pos2(10) As Integer, veld(30) As String, aantal As Integer, KL As String
  
  Worksheets("Blad1").Activate
  Set selectedcell = Application.ActiveCell
  KolomNummer = selectedcell.Column         ' GEEFT KOLOM NUMMER   https://www.educba.com/vba-active-cell/
  KL = Kolom_Letter(KolomNummer)            ' GEEFT KOLOMLETTER uit function
  RijNummer = selectedcell.Row              ' GEEFT RIJNUMMER
  
'MsgBox ("Cel =  " & KL & "  " & RijNummer)
  
  If ActiveCell.Comment Is Nothing Then
    Comtext = ""
      MsgBox ("1 Er is geen comment"), vbExclamation
    GoTo Uit
  Else
    Comtext = ActiveCell.Comment.Text
    If Comtext = "" Then
      MsgBox ("Er staat geen tekst in de Opmerking!")
      GoTo Uit
    End If
  End If

  Dim Wdoc As String
    Wdoc = ActiveWorkbook.Worksheets("Blad1").Range("K9") & ".doc"
    If FileInWordOpen(Wdoc) Then                    ' checkt of Basis Word-file al open is
      MsgBox "Het bestand " & Wdoc & " is open in Word"
      GoTo Door
    Else
      MsgBox "Het bestand " & Wdoc & " is niet open in Word"
  
      WrdBestand = ActiveWorkbook.Worksheets("Blad1").Range("K7") & "\" & ActiveWorkbook.Worksheets("Blad1").Range("K9") & ".doc"     ' opent BASIS-FILE COMMENT
      Set Word = CreateObject("word.basic")       ' Set Word
      Word.fileopen WrdBestand                    ' opent een Word document met het Path & Naam file & extensie
     Word.appshow                                 ' toont het document
    End If
Door:
  With Range(KL & RijNummer)
    Set C = .Comment
    On Error GoTo 0
    If C Is Nothing Then
      MsgBox ("2 Er is geen comment"), vbExclamation
      VarComment = " "                        ' een spatie doorgeven anders foutmelding!
    Else
      VarComment = C.Text
    End If
  End With
 Dim Adres, s As Variant, sp As Variant
  For Each cl In Selection.Cells
    aantal = 0
'      Dim sp, regels As Integer
'      sp = Split(cl.Value)
'      regels = UBound(sp) + 1                   ' start bij 0 dus plus 1
'     MsgBox ("regels =  " & regels)
    Adres = "Bijlage 15 - cel-adres = " & cl.Address
 
    For i = 1 To Len(VarComment)
      If Mid(VarComment, i, 1) = vbLf Then              ' laatste regel een vbLf
        aantal = aantal + 1
        If aantal = 1 Then pos1(1) = aantal
        If aantal > 1 Then pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = i - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
        If i = Len(cl) Then Exit For
      End If
      If i = Len(VarComment) And aantal > 0 Then        ' één regel zonder vbLf
        aantal = aantal + 1
        pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = (i + 1) - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
      End If
      If i = Len(VarComment) And aantal = 0 Then        ' twee regels één met vbLf en laatste zonder vbLf
        aantal = aantal + 1
        pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = (i + 1) - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
      End If
    Next i
  Next
 
'  With GetObject(WrdBestand)                                                    ' Update variabelen van Excel --> Word doc.
'    For i = 0 To 10
'      If i = 0 Then .variables("veld" & i) = Adres: GoTo Door
'      If veld(i) = "" Then veld(i) = ".": .variables("veld" & i) = veld(i): GoTo Door
'      .variables("veld" & i) = veld(i) ': MsgBox ("2 i =  " & i)
'Door:
'    Next i
'    .Fields.Update
'  End With

   s = vbLf & VarComment & WorksheetFunction.Rept(vbLf, 51)   ' voeg vooraan 1 vblf (voor je adres straks) en achteraan nog voldoende (40) vblf's toe aan je varcomment
'   MsgBox "dit wordt straks gesplitst : " & vbLf & s
   sp = Split(s, vbLf)                                        ' splits dan op die vblf

[COLOR="#FF0000"]   With GetObject(WrdBestand)                                 ' Update variabelen van Excel --> Word doc.
     For i = 0 To 51
       Select Case i
         Case 0: .variables("veld0") = Adres
         Case Else:
         .variables("veld" & i) = IIf(sp(i) = "", ".", sp(i))     'was het knipsel leeg, zet er dan een punt in, anders het knipsel zelf
       End Select
     Next i
    .Fields.Update
   End With[/COLOR]
Uit:
End Sub
 
Dé manier om te testen of een Word-bestand geopend is en de inhoud ervan naar een werkblad te kopiëren:

Code: 
Sub M_snb()
   getobject("G:\OF\voorbeeld.docx").content.copy thisworkbook.Sheets(1).cells(1)
End sub
 
he thanks snb,

Is er ook een manier om te kijken of er al wat in de Tabel op het Word document staat?

probeer nu met
Code: 
   If .variables("veld" & Rij) <> "" And .variables("veld" & Rij) <> "." Then GoTo VR    ' volgende regel

maar dat werkt dus niet
 
Code: 
         [COLOR="#FF0000"][SIZE=4]' [/SIZE][/COLOR]  MsgBox "dit wordt straks gesplitst : " & vbLf & s
Door dat ' teken is die msgbox comment geworden, haal die heel eventjes voor de test weg.
Krijg je dan in die msgbox op zoveelste regel ook 2 punten, dan heb je de oorzaak gevonden en stopt het giswerk, anders ... (3 puntjes :eek:)
 
Test of een Word document een tabel bevat:

Code: 
Sub M_snb()
   msgbox getobject("G:\OF\voorbeeld.docx").tables.count
End sub
 
cow18 zei:
Code: 
         [COLOR="#FF0000"][SIZE=4]' [/SIZE][/COLOR]  MsgBox "dit wordt straks gesplitst : " & vbLf & s
Door dat ' teken is die msgbox comment geworden, haal die heel eventjes voor de test weg.
Krijg je dan in die msgbox op zoveelste regel ook 2 punten, dan heb je de oorzaak gevonden en stopt het giswerk, anders ... (3 puntjes :eek:)
Klik om te vergroten...

Goedenavond Cow,

Thanks net even gekeken met onderstaande codes, maar helaas veranderd niets

Code: 
   s = vbLf & VarComment & WorksheetFunction.Rept(vbLf, 51)   'voeg vooraan 1 vblf (voor je adres straks) en achteraan nog voldoende (40) vblf's toe aan je varcomment
   sp = Split(s, vbLf)                                        'splits dan op die vblf

   With GetObject(WrdBestand)                                 ' Update variabelen van Excel --> Word doc.
     For i = 0 To 51
       Select Case i
         Case 0: .variables("veld0") = Adres
         Case Else: .variables("veld" & i) = IIf(sp(i) = "", ".", sp(i))     'was het knipsel leeg, zet er dan een punt in, anders het knipsel zelf
       End Select
     Next i
    .Fields.Update
   End With
 
Thanks snb, werkt kan nu dus zien of er een Tabel(len) is/zijn op het destreffende document.

Maar is er ook een optie om te kijken of er iets staat op iedere rij?
Wilde dus meerdere comments op hetzelfde document zetten, maar dan zou die dus de Tabel moeten checken op de eerstvolgende lege rij om vervolgens daar dan de volgende comment neer te zetten.
 
Thanks net even gekeken met onderstaande codes, maar helaas veranderd niets
Klik om te vergroten...
de vraagstelling in #8 was "waar komen die 2 puntjes vandaan ?" met een hypothese Rara? heeft dit te maken met 1 en 11? zie rode deel..
Nu heb je die msgbox die er enkel voor comment stond door dat enkel aanhalingsteken helemaal weggehaald, dus natuurlijk maakt dat geen verschil.

Ik had enkel willen aangeven, haal enkel dat enkel aanhalingsteken weg, zodat die regel uitgevoerd wordt en je effectief een msgbox op je bord krijgt. Dan kan je op de 11e regel zien dat er daar 2 puntjes staan en is de zaak uitgeklaard, geen verder giswerk meer. Daarna kan je die msgbox weer inactief maken.
Zulke zaken kan je ook in debug-mode (in de editor met F8 en F9) uitzoeken, maar het is zaterdagavond, dat ga ik nu niet uitleggen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan