Passing variables from Child (Word) to Parent (Excel)

[gruntingmonkey]

Hello, I have spent all day on this and I just can't figure it out. I have an Excel macro which passes some variables to a word sub which works great. What I am then trying to do is pass a Boolean (FileExists) back to Excel but I just have no idea how. I have completely changed loads of bits in my code, I've tried to put it as a string, changed it to public sub, option explicit.... Nothing I do... i'm lost. Can anyone help? Code below:

This is the Excel code

Public FileExists As String
Option Explicit
Sub CreateSelfFundedContract()
Dim wdApp As New Word.Application, wdDoc As Word.Document, wdPropDoc As Word.Document
Dim UserNm As String, ConTemp As String, AccID As String, Dt As String, Serv As String
Dim clName As String, SvNm As String, proposal As String, strDocNm As String
Dim SalesSig As String, Condate As String, Canname As String, FileExists As String, OpenWordDoc As String, filepath As String



'''Error Handle
On Error GoTo MyErrorHandler

UserNm = Environ$("Username")

'''This is the Contract master template
ConTemp = "C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\Templates\Master Self Funder Contract.docm"

'''Creates a document from the template
Set wdDoc = wdApp.Documents.Add(ConTemp)
  
''''makes it so you can see the word file
With wdApp
        .Visible = True
        .Activate
End With

'''Variables to pass to Word
SalesSig = Worksheets("Self Funded Mail Merge").Cells(2, 5).Value
Condate = Format(Worksheets("Self Funded Contract Data Input").Cells(10, 4).Value, "yyyymmdd")
Canname = Worksheets("Self Funded Contract Data Input").Cells(8, 4).Value
FileExists=True

'''Run Word macro
wdApp.Application.Run "Module1.LinkMergeData", SalesSig, Condate, Canname ', FileExists

OpenWordDoc = wdApp.ActiveDocument.Name

wdApp.Quit SaveChanges:=wdDoNotSaveChanges

ThisWorkbook.Activate





FileExists = FileExists

If FileExists = False Then

'' updates utilities sheet
    Sheets("Utilities").Cells(7, 2).Value = Application.UserName & " " & Now
        Sheets("Utilities").Cells(7, 4).Value = "Complete"
End If

Sheets("Utilities").Activate

Set wdDoc = Nothing: Set wdApp = Nothing
Exit Sub



MyErrorHandler:
wdApp.Quit SaveChanges:=wdDoNotSaveChanges
MsgBox "Uh oh - It all went wrong!!! Let Jess know and she will sort it for you....probably....Please tell her the following issue:" & vbNewLine & vbNewLine & Err.Description

Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

And then heres the code in Word:

Public FileExists As String
Option Explicit


Public Sub LinkMergeData(SalesSig As String, Condate As String, Canname As String, FileExists As String)
 
 Dim UserNm As String, Conmas As String, Answer As String

 '''masterfile quicklink
Conmas = "C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\~ Contract Creator Master File.xlsm"
   
  
  '''''add signature
          Selection.GoTo What:=wdGoToBookmark, Name:="Signature"
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.InlineShapes.AddPicture FileName:= _
        "C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\Authorisation Signatures\" & SalesSig & ".jpg" _
        , LinkToFile:=False, SaveWithDocument:=True
        
        
'''Link the open contract file to the wizard merge data info
 ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:=Conmas _
        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=ConMas;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database=""""" _
        , SQLStatement:="SELECT * FROM `'Self Funded Mail Merge$'`", _
        SQLStatement1:="", SubType:=wdMergeSubTypeAccess
   
   
   
   ' ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
      
     

'''Check to see if File exists already
     Dim TestStr As String
    TestStr = ""
    On Error Resume Next
    TestStr = Dir("C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\Contracts\SF " & Canname & " " & Condate & ".docx")
    On Error GoTo 0
    If TestStr = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
     
     
     
If FileExists = False Then
     
     ActiveDocument.SaveAs2 FileName:= _
        "C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\Contracts\SF " & Canname & " " & Condate & ".docx" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
         
       '  ActiveWindow.Close
       
       FileExists = True
       Exit Sub
End If
     
     
     
If FileExists = True Then
     Answer = MsgBox("This file already exists, do you want to overwrite it?", vbQuestion + vbYesNo, "Overwrite Message")
    If Answer = vbYes Then
           ActiveDocument.SaveAs2 FileName:= _
        "C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\Contracts\SF " & Canname & " " & Condate & ".docx" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
       
             '   ActiveWindow.Close
                Exit Sub
     End If
End If
     
     
     Exit Sub
     
End Sub

 

[gruntingmonkey]

I have answered the first part of this by using Application.Activate if the msgbox appears at all.

Still havent worked out how to tell from Excel what the result of the Yes/No question is.

 

[Macropod]

Excellent, that works now. However.... It doesnt bring up the VB question to the front of the screen if its already created. How do I do this?

The 'If Dir(MMOut) <> "" Then' test should find the file if it exists and display the message box. Maybe the message box is being hidden behind the Excel window?

And also, how can I tell what the answer is to that question in Excel?

Where in Excel would the answer go?

 

[Macropod]

How would I have all the code in Excel? This would negate my need to pass a variable between applications.

It's pretty much just a case of moving your existing Word code into Excel. For example:

Option Explicit

Sub CreateSelfFundedContract()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim ConTemp As String, SalesSig As String, Condate As String, Canname As String
Dim UserNm As String, StrPath As String, MMSrc As String, MMOut As String

'''Error Handler
On Error GoTo MyErrorHandler

'''File Path & name variables
UserNm = Environ$("Username")
StrPath = "C:\Users\" & UserNm & "\The Jess Consultancy\Sales - Documents\Contracts\~ Contract Wizard\"
ConTemp = StrPath & "Templates\Master Self Funder Contract.docx"
MMSrc = StrPath & "~ Contract Creator Master File.xlsm"
MMOut = StrPath & "Contracts\SF " & Canname & " " & Condate & ".docx"

'''Variables to pass to Word
SalesSig = Worksheets("Self Funded Mail Merge").Cells(2, 5).Value
Condate = Format(Worksheets("Self Funded Contract Data Input").Cells(10, 4).Value, "yyyymmdd")
Canname = Worksheets("Self Funded Contract Data Input").Cells(8, 4).Value


If Dir(ConTemp) <> "" Then
  With wdApp
    ''' Prevent errors caused by someone saving the Contract master as a mailmerge main document
    .DisplayAlerts = wdAlertsNone
    ''''makes it so you can see the word file
    .Visible = True
    '''Creates a new document from the Contract master
    Set wdDoc = wdApp.Documents.Add(ConTemp)

    With wdDoc
      .InlineShapes.AddPicture Filename:=StrPath & "Authorisation Signatures\" & SalesSig & ".jpg", Range:=.Bookmarks("Signature").Range
        
      '''Link the open contract file to the wizard merge data info
      With .MailMerge
        .MainDocumentType = wdFormLetters
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .OpenDataSource Name:=MMSrc, ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=True, _
          AddToRecentFiles:=False, Format:=wdOpenFormatAuto, Connection:= _
          "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=MMSrc;" & _
          "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database=""""", _
          SQLStatement:="SELECT * FROM `'Self Funded Mail Merge$'`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess

        With .DataSource
          .FirstRecord = wdDefaultFirstRecord
          .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
      End With
      .Close False
    End With
    
    '''Check to see if File exists already
    If Dir(MMOut) <> "" Then
      If MsgBox("This file already exists:" & vbCr & MMOut & vbCr & "Overwrite it?", vbQuestion + vbYesNo, "Overwrite Query") = vbNo Then
  
        '' updates utilities sheet
        With Sheets("Utilities")
          .Cells(7, 2).Value = ""
          .Cells(7, 4).Value = "InComplete"
        End With
        .ActiveDocument.Close False
        GoTo wdExit
      End If
    End If
    With .ActiveDocument
      .SaveAs2 Filename:=MMOut, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=True, CompatibilityMode:=15
      .Close False
    End With
    
  '' updates utilities sheet
    With Sheets("Utilities")
      .Cells(7, 2).Value = Application.UserName & " " & Now
      .Cells(7, 4).Value = "Complete"
    End With
wdExit:

    '''Check for any new errors
    .DisplayAlerts = wdAlertsAll
    ''' Exit Word without saving changes to the Contract master
    .Quit
  End With
  Set wdDoc = Nothing: Set wdApp = Nothing
End If
Sheets("Utilities").Activate
Exit Sub

MyErrorHandler:
MsgBox "Uh oh - It all went wrong!!! Let Jess know and she will sort it for you....probably....Please tell her the following issue:" & vbNewLine & vbNewLine & Err.Description
End Sub

Note that the above code assumes your contract master will now be a docx file.

 

[gruntingmonkey]

Where in Excel would the answer go?

If it was not overwritten, then the following should say "Incomplete"

  '' updates utilities sheet
    With Sheets("Utilities")
      .Cells(7, 2).Value = Application.UserName & " " & Now
      .Cells(7, 4).Value = "Complete"
    End With

 

[Macropod]

If it was not overwritten, then the following should say "Incomplete"

Which is what the code in post # 13 should do. To make it stand out more though, the username & time are not output - but it's easy to add that back in if you want.

 

[gruntingmonkey]

This is just excellent. I've now transferred all of the code to Excel which makes it much easier to work with. I have made a few adaptions to your code but thank you soooo much for setting me on the right path.