close Unsaved open Word Document via Excel

[Dossfm0q]

how to close unsaved Opend Word information with out save

Sub FnGetOpenedDocInstance()

Dim WB As Workbook
Dim WS As Worksheet
Dim DfltPth As String
Dim Dfltname As String

Set WB = ThisWorkbook
Set WS = WB.Worksheets(1)
DfltPth = WB.Path
Dfltname = DfltPth & "\CSE.docx"
Dim Rng As Range, InputRng As Range
Set InputRng = WS.Range("B1:B30")
LastRng = WS.Range(InputRng(InputRng.Cells.Count).Address)

On Error Resume Next
Dim WordApp As Word.Application
Set WordApp = GetObject(, "Word.Application")
Dim WordDoc As Word.Document
Dim slction
Dim Cntnt

Dim Cnt As Long

'________________________________________________________________________________________________________________________________________________________________________________________________________ & _
 ________________________________________________________________________________________________________________________________________________________________________________________________________
' Delete All unSaved Open Documents
For Each WordDoc In WordApp.Documents
    
    If WordDoc.FullName = WordDoc.Name Then
        If WordApp.Documents.Count > 1 Then
         For I = 1 To WordDoc.Documents.Count - 1
            If WordDoc.Saved = True Then
            WordDoc.Close , wdDoNotSaveChanges
            Else
            fltname = DfltPth & "\" & WordDoc.Name & ".docx"
            [COLOR=rgb(226, 80, 65)]WordDoc.SaveAs fltname[/COLOR]
            WordDoc.Close
            Kill fltname
            End If
             Next
                Else
            If WordDoc.Saved = True Then
            WordDoc.Close , wdDoNotSaveChanges
            WordApp.Quit
            Else
            fltname = DfltPth & "\" & WordDoc.Name & ".docx"
            [COLOR=rgb(226, 80, 65)]WordDoc.SaveAs fltname[/COLOR]
            WordDoc.Close
            WordApp.Quit
            Kill fltname
            End If
        End If
    End If
Next
On Error GoTo 0
'________________________________________________________________________________________________________________________________________________________________________________________________________ & _
 ________________________________________________________________________________________________________________________________________________________________________________________________________
' Create New Doc
Set WordApp = Nothing
Set WordApp = CreateObject("Word.Application")
Set Doc = WordApp.Documents.Add
With WordApp
    .Visible = True
    .Activate
Set slction = .selection
End With
Set Cntnt = Doc.Content
Dim RngVal As String, TXT As String
'Get Data
TXT = ""
For Each Rng In InputRng

Rw = Rng.Row
Cl = Rng.Column

RngVal = Rng.Value
RngValOSB = WS.Cells(Rw + 1, Cl).Value ' Offset Bottom
RngValOSL = WS.Cells(Rw, Cl - 1).Value ' Offset Left
RngValOSLB = WS.Cells(Rw + 1, Cl - 1).Value ' Offset Left Bottom


If RngValOSL <> "Box" Then
    If (RngVal <> "" And Left(RngVal, 1) <> "•" And InStr(TXT, "•") = 0) Then
        If Left(RngVal, 1) = "•" Or RngValOSL = "F" Then
        TXT = TXT & IIf(TXT <> "", vbNewLine, "") & RngVal
        Else
        TXT = TXT & " " & RngVal
        End If
        
        
        If Left(RngValOSB, 1) = "•" Or (RngValOSLB = "f" Or RngValOSLB = "F") Or Rng = LastRng Then
         MsgBox TXT
        TXT = ""
        End If
        
    ElseIf (RngVal <> "" And Left(RngVal, 1) = "•") Or (Left(RngVal, 1) <> "•" And InStr(TXT, "•") <> 0) Then
        If Left(RngVal, 1) = "•" Or RngValOSL = "F" Then
        TXT = TXT & IIf(TXT <> "", vbNewLine, "") & RngVal
        Else
        TXT = TXT & " " & RngVal
        End If
        If (RngValOSLB = "f" Or RngValOSLB = "F") Or Rng = LastRng Then
        TXT = ""
        End If
        
    End If

Else


End If







Next





End Sub

 

[NdNoviceHlp]

I don't understand? Why not just set application.display alerts to false and close all of your documents? The saved ones will close (already saved anyways) and the unsaved ones will close without saving. HTH. Dave