Run vbs file and copy folder name into excel

Hi all,

I have a .vbs file which opens an existing excel macro file and run specified macro.

Then, Excel macro will open an existing word document and replaces few strings on that file.
I need to update the current folder name (where the .vbs file located) into the word document through excel macro.

With the following code I can able to update the current excel file location. However, I need the file path and folder name where we copied & run the .vbs file .

.Replacement.Text = Mid(ActiveDocument.Path, InStrRev(ActiveDocument.Path, "") + 1)

Here is the source code (.vbs file) to open excel and run macro:

Set objExcel = CreateObject("Excel.Application")
objExcel.Application.Run "'C:\Users\SS\Downloads\Test Temp\FIN Tool_1.xlsm'!Module1.Test22"
objExcel.DisplayAlerts = False
objExcel.Application.Quit
Set objExcel = Nothing

VBA MACRO source code to open word document and replace strings:

Sub Test22()

Dim book1 As Word.Application
Dim sheet1 As Word.Document
Dim scriptpath As String
Set book1 = CreateObject("word.application")
book1.Visible = True
Set sheet1 = book1.Documents.Open("C:\Users\Sailaja Srinivas\Downloads\Test Temp\FIN_Template.docx")

With sheet1.Content.Find

        .Text = "USERNAME"
        .Replacement.Text = "SRINIVAS PONNADA"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .Execute Replace:=wdReplaceAll
End With

With sheet1.Content.Find

        .Text = "CURRENT FILE FOLDER"
        .Replacement.Text = Mid(ActiveDocument.Path, InStrRev(ActiveDocument.Path, "") + 1)
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .Execute Replace:=wdReplaceAll
End With
End Sub