activating a word doc

[hearthhrob4gals]

hi,

my below code works well when no word document is opened prior to running the macro. However, if there is already an opened word document, and then another word document is opened through the macro thn instead of executing data from the newly opened doc, it takes data from the previously opened doc.

Set wordapp = CreateObject("word.Application")
  wordapp.Documents.Open DOCFilenm
  wordapp.Visible = True
  wordapp.Activate
  Documents.Open(DOCFilenm).Activate
  Set wdDoc = wordapp.ActiveDocument
     ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
     ActiveDocument.MailMerge.OpenDataSource Name:=ExcelFilenm, Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=ExcelFilenm" _
           , SQLStatement:="SELECT * FROM `'60 Days$'`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
     
     For x = 1 To LS60
         With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
                .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            End With
            .Execute Pause:=False
        End With
        ChangeFileOpenDirectory DirPath
        On Error Resume Next
        dt = ExcelWbk.Sheets("60 Days").Range("F" & x + 1).Value
        dt = Replace(dt, "/", "-")
        dt = Replace(dt, "\", "-")
        dt = Format(dt, "mm-dd-yyyy")
        On Error GoTo 0
        EmpId = ExcelWbk.Sheets("60 Days").Range("C" & x + 1).Value
        CostCenter = ExcelWbk.Sheets("60 Days").Range("B" & x + 1).Value
        CostCenter = Trim(Left(CostCenter, 4))
        CardMemName = ExcelWbk.Sheets("60 Days").Range("A" & x + 1).Value
        CardMemName = Left(Trim(CardMemName), 1)
        ExcelWbk.Sheets("60 Days").Range("Z" & x + 1).Formula = "=RIGHT(A" & x + 1 & ",LEN(A" & x + 1 & ")-FIND(""#"",SUBSTITUTE(A" & x + 1 & ","" "",""#"",LEN(A" & x + 1 & ")-LEN(SUBSTITUTE(A" & x + 1 & ","" "",""""))),1))"
        ExcelWbk.Sheets("60 Days").Range("Z" & x + 1).Copy
        ExcelWbk.Sheets("60 Days").Range("Z" & x + 1).PasteSpecial xlPasteValues
        CardMemName = CardMemName & " " & ExcelWbk.Sheets("60 Days").Range("Z" & x + 1).Value
        
 


  wdDoc.Close

problem is that it should consider DOCFilenm as active doc ,however if any xyz word doc was open before running the macro it consider that file as active instead of DOCFilenm

 

[Norie]

Why not set a variable to reference the document you are opening and in the code replace ActiveDocument with that variable?

You've actually got a variable you could use for that, wdDoc.

Though you should change this code,

Documents.Open(DOCFilenm).Activate
  Set wdDoc = wordapp.ActiveDocument

to something like this,

Set wdDoc =wordapp.Documents.Open(DOCFilenm)

and replace ActiveDocument with wdDoc throughout the rest of the code.

 

[hearthhrob4gals]

Why not set a variable to reference the document you are opening and in the code replace ActiveDocument with that variable?

You've actually got a variable you could use for that, wdDoc.

Though you should change this code,

Documents.Open(DOCFilenm).Activate
  Set wdDoc = wordapp.ActiveDocument

to something like this,

Set wdDoc =wordapp.Documents.Open(DOCFilenm)

and replace ActiveDocument with wdDoc throughout the rest of the code.

Thanks...now i am getting this error (System Error &H80010108 (-2147417848). (The object invoked has disconnected from its clients.
)...any idea how this can be fixed.

and this is the revised code

  Set wordapp = CreateObject("word.Application")  wordapp.Documents.Open DOCFilenm
  wordapp.Visible = True
  wordapp.Activate
  Set wdDoc = wordapp.Documents.Open(DOCFilenm)
  
     wdDoc.MailMerge.MainDocumentType = wdFormLetters
     wdDoc.MailMerge.OpenDataSource Name:=ExcelFilenm, Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=ExcelFilenm" _
           , SQLStatement:="SELECT * FROM `'60 Days$'`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
     
     For x = 1 To LS60
         With wdDoc.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = wdDoc.MailMerge.DataSource.ActiveRecord
                .LastRecord = wdDoc.MailMerge.DataSource.ActiveRecord
            End With
            .Execute Pause:=False
        End With

 

[Norie]

Where do you get the error?