Saving a file name to an Excel named range

[StevieMP]

Hi There,
I have some VBA code which copies a range from an Excel sheet into a Word document and saves and that seems to work fine. Once the information has been saved, I want to take the name of the file which has been created and save the address e.g. C:\Users\Documents\example.docx to a cell in a sheet in Excel which has a named range.

The code is attached.

What I am seeing in the range is not the file I saved but a different file.

Can someone please help?

The file is saved in the directory and I can see this : C:\Users\P3001951\Documents\MWIRE_DSMatch set up form for TEST 17-12-2021.PDF

wdapp.ActiveDocument.SaveAs2 filename:=dpath & "MWIRE_DSMatch set up form for" & " " & filename & " " & Format(Now(), "DD-MM-YYYY") & ".PDF", _
FileFormat:=17

and the location where the file is to go is here:

For Each wdapp In Application.Workbooks
ThisWorkbook.sheets("Sheet2").Range("MWIREDSMatch,MWIREDSMatch1").Value = wdapp.FullName
Next

(but what is being populated in the cell is this: C:\Users\P3001951\Documents\Cleared OTC OnBoarding incl Bilateral OTC and FFX.xlsm which is the name of the spreadsheet I am running the code from).


Sub CreateMWIREDSMATCHSheet()

'This code will copy the sheet and create a New Word Document from the Excel sheet "MWIRE_DSMatch" in order to be sent to MarkitWire.

Dim wdapp As Object, wdDoc As Object, bStart As Boolean
bStart = False

Dim TblRange As Excel.Range
Dim Workbook As Workbook
Dim dpath As String
Dim filename As String
Dim tbl As Table, tbl2 As Table
Dim wd As Document
Dim filepath As String


dpath = "C:\Users\P3001951\Documents\"
'"G:\DATA\BACKOFF\SETTLEME\Derivatives\OTC\Fund Launches\MWIRE_DSMATCH set up form master docs\"

On Error Resume Next
Set wdapp = GetObject(, "Word.Application")
On Error GoTo 0

If wdapp Is Nothing Then
Set wdapp = CreateObject(Class:="Word.Application")
bStart = True
End If


Application.StatusBar = "Creating new document..."
Application.StatusBar = "Copying data from " & "MWIRE_DSMatch"


Set TblRange = ThisWorkbook.Worksheets("MWIRE_DSMatch").Range("A3:H84")
Range("B47:H61").WrapText = True
'Range("B47:H61").WrapText = False
Range("A3:H84").Copy



With wdapp
.Visible = True
'Create new Document
Set wdDoc = .Documents.Add
With wdDoc
With .PageSetup
.Orientation = 0 'wdOrientLandscape
.TopMargin = wdapp.InchesToPoints(0.1)
.BottomMargin = wdapp.InchesToPoints(0.1)
.LeftMargin = wdapp.InchesToPoints(0.1)
.RightMargin = wdapp.InchesToPoints(0.1)

End With

.Range.PasteSpecial (xlPasteValues)
.Tables(1).AutoFitBehavior 2 'wdAutoFitWindow


filename = Range("K2")
wdapp.ActiveDocument.SaveAs2 filename:=dpath & "MWIRE_DSMatch set up form for" & " " & filename & " " & Format(Now(), "DD-MM-YYYY") & ".docx", _
FileFormat:=12

wdapp.ActiveDocument.SaveAs2 filename:=dpath & "MWIRE_DSMatch set up form for" & " " & filename & " " & Format(Now(), "DD-MM-YYYY") & ".PDF", _
FileFormat:=17


For Each wdapp In Application.Workbooks
ThisWorkbook.sheets("Sheet2").Range("MWIREDSMatch,MWIREDSMatch1").Value = wdapp.FullName
Next


'wdapp.ActiveDocument.Close

With wdapp
If Dir(filepath) <> "" Then
Kill filepath
End If
End With

End With
'If bStart = True Then .Quit
End With

Application.CutCopyMode = False

'Clean up the Object when Finished
Set wdDoc = Nothing: Set wdapp = Nothing

Application.StatusBar = "Finished & Saved."

End Sub

 

[6StringJazzer]

This code seems to be very confused (BTW your code will be much easier to read if you use code tags)

For Each wdapp In Application.Workbooks
   ThisWorkbook.sheets("Sheet2").Range("MWIREDSMatch,MWIREDSMatch1").Value = wdapp.FullName
Next

wdapp is the Object that is your Word application. There is only one of them. I don't know why you created a loop here--you just need to do one thing. Also Workbooks is the collection of currently open workbooks in Excel. So if you do this you will wipe out the value of wdapp and lose the ability to reference the Word application. Second, the way this loop is written, wdapp.Fullname is not the name of the Word file, it is the name of the workbook in that pass of the loop. What this loop actually does is puts the name of every open workbook into your named range. What you see there is the final one after the loop finished.

Based on what you described you want to do, you need to replace these three lines with this one line:

ThisWorkbook.sheets("Sheet2").Range("MWIREDSMatch,MWIREDSMatch1").Value = wdapp.ActiveDocument.FullName

 

[StevieMP]

This code seems to be very confused (BTW your code will be much easier to read if you use code tags)

For Each wdapp In Application.Workbooks
   ThisWorkbook.sheets("Sheet2").Range("MWIREDSMatch,MWIREDSMatch1").Value = wdapp.FullName
Next

wdapp is the Object that is your Word application. There is only one of them. I don't know why you created a loop here--you just need to do one thing. Also Workbooks is the collection of currently open workbooks in Excel. So if you do this you will wipe out the value of wdapp and lose the ability to reference the Word application. Second, the way this loop is written, wdapp.Fullname is not the name of the Word file, it is the name of the workbook in that pass of the loop. What this loop actually does is puts the name of every open workbook into your named range. What you see there is the final one after the loop finished.

Based on what you described you want to do, you need to replace these three lines with this one line:

ThisWorkbook.sheets("Sheet2").Range("MWIREDSMatch,MWIREDSMatch1").Value = wdapp.ActiveDocument.FullName

Thank you Very Much!!!! I've been staring at that for days.
That works perfectly....really appreciate your help

 

[StevieMP]

Thank you Very Much!!!! I've been staring at that for days.
That works perfectly....really appreciate your help

What would I need to change to save the PDF created to the named range?