Reputation: 39
I am trying to create button in Excel which will call VBA script which will change text file.
I have text file which looks like:
String 1
String2
...
String 123
Invoke-WebRequest -Uri https://www.example.com/publicdocs/files/iceu/2022/07/IPE0729F.CSV.zip
-OutFile C:\folder\files\IPE0802F.CSV.zip
String 125
....
String 999
What I need is to change string:
Invoke-WebRequest -Uri https://www.example.com/publicdocs/files/iceu/2022/07/ABB0729F.CSV.zip -OutFile C:\folder\files\ABB0802F.CSV.zip
and replace dates with values from cells, i.e.: replace 2022 with
Range("A1").Value
Replace 07 with
Range("A2").Value
Replace 0729
with Range("A3").Value
Replace 0802
With Range("A4").Value
So I need to find this string in text file, modify it and save file. Maybe someone can help with that since looks like I have no enough knowledge to achieve it (
Ok, here I can find needed string, but I dont know how to replace whole string with updated one:
Sub updatePS()
Const ForReading = 1, ForWriting = 2
Dim FSO, FileIn, FileOut, strTmp
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileIn = FSO.OpenTextFile("C:\powershell.ps1", ForReading)
Set FileOut = FSO.OpenTextFile("C:\powershell2.ps1", ForWriting, True)
Do Until FileIn.AtEndOfStream
strTmp = FileIn.ReadLine
If Len(strTmp) > 0 Then
If InStr(1, strTmp, "Invoke-WebRequest", vbTextCompare) > 0 Then
' Here I should add code to replace updated string
End If
End If
Loop
FileIn.Close
FileOut.Close
End Sub
Upvotes: 0
Views: 418
Reputation:
Check out the vba Replace() function, You can set multiple replaces by:
Replace(Replace(Replace(put here 3 replace conditions)))
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/replace-function
Upvotes: 0
Reputation: 42236
You did not answer all my clarification questions...
The the next solution assumes that "2022" and "07" are both between "/" two such characters and "0729" / "0802" have a following suffix of "F.C" string. Otherwise, the code could strictly replace the strings you asked for, but the possibility to also replace in different locations exists:
Sub ModifScript()
Dim sh As Worksheet, fso As Object, ts As Object, sPath As String, sFile As String, strText As String
Set sh = ActiveSheet
sPath = ThisWorkbook.Path & "\" 'use here your real path, please!
sFile = "powershell.ps1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.getFile(sPath & sFile).OpenAsTextStream(1, -2)
strText = ts.ReadAll
ts.Close
Dim chngTxt As String, chngText As String, frstChar As Long, frstChar2 As Long, endChar As Long
frstChar = 1 'first character, where from InStr start evaluation
frstChar = InStr(frstChar, strText, "Invoke-WebRequest") 'the digit number where the necessary string (to be changed) starts
frstChar2 = InStr(frstChar + Len("Invoke-WebRequest"), strText, "OutFile C:\") 'this returns the real ending of the necessary string...
endChar = InStr(frstChar2 + Len("Invoke-WebRequest"), strText, "F.CSV.zip") 'the digit number where the necessary string ends
'string to be processed:
chngTxt = Mid(strText, frstChar, endChar + Len("F.CSV.zip") - frstChar)
Debug.Print chngTxt 'just to visually check that the correct string to be changed has been returned
chngText = Replace(Replace(chngTxt, "/2022/", "/" & sh.Range("A1").value & "/"), "/07/", "/" & sh.Range("A2").value & "/")
chngText = Replace(Replace(chngText, "0729F.C", sh.Range("A3").value & "F.C"), "0802F.C", sh.Range("A4").value & "F.C")
Debug.Print chngText 'just to visually check that the string to be changed has been correctly changed
'replace the changed string in the original file text:
strText = Replace(strText, chngTxt, chngText) 'the changed whole string!
Debug.Print strText
Dim scriptFold As String, pathToFile As String
If Dir(sPath & "Scripts", vbDirectory) = "" Then MkDir sPath & "Scripts" 'create "Scripts" folder if it does not exist
pathToFile = sPath & "Scripts\" & sFile
Open pathToFile For Output As #1
Print #1, strText
Close #1
End Sub
The above code saves the processed file content in a new folder ("Scripts), created by the code, if not exists...
Basically, you should use the same script file, but always update the column B:B of the active sheet with the changed string (taken from A:A). It is necessary to only replace in code "/2022/"
with "/" & Sh.Range("B1").value & "/"
, "/07/"
with "/" & Sh.Range("B2").value & "/"
, "0729F.C"
with Sh.Range("B2").value & "S.C"
and so on...
Edited:
Please, test the next variant. It does not need the existing strings to be replaced, anymore. This code is able to firstly identify/extract the strings to be replaced and then replaces them with the one from the Excel sheet:
Sub ModifScript_Next()
Dim sh As Worksheet, fso As Object, ts As Object, sPath As String, sFile As String, strText As String
Set sh = ActiveSheet
sPath = ThisWorkbook.Path & "\"
sFile = "powershell.ps1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.getFile(sPath & sFile).OpenAsTextStream(1, -2)
strText = ts.ReadAll
ts.Close
Dim chngTxt As String, chngText As String, frstChar As Long, frstChar2, endChar As Long
frstChar = 1 'first character, where from InStr start evaluation
frstChar = InStr(frstChar, strText, "Invoke-WebRequest") 'the digit number where the necessary string (to be changed) starts
frstChar2 = InStr(frstChar + Len("Invoke-WebRequest"), strText, "OutFile C:\") 'this returns the real ending of the necessary string...
endChar = InStr(frstChar2 + Len("Invoke-WebRequest"), strText, "F.CSV.zip") 'the digit number where the necessary string ends
'string to be processed:
chngTxt = Mid(strText, frstChar, endChar + Len("F.CSV.zip") - frstChar)
Debug.Print chngTxt 'just to visually check that the correct string to be changed has been returned
Dim frstStr As String, secStr As String, thrdStr As String, fourStr As String, frstC As Long, secCh As Long
'extract first string:
frstC = InStr(1, chngTxt, "docs/files/iceu/")
secCh = InStr(frstC + Len("docs/files/iceu/"), chngTxt, "/")
frstStr = Mid(chngTxt, frstC + Len("docs/files/iceu/"), secCh - (frstC + Len("docs/files/iceu/")))
'Debug.Print "_" & frstStr & "_" 'OK
'extract second string:
frstC = secCh + 1
secCh = InStr(frstC, chngTxt, "/IPE")
secStr = Mid(chngTxt, frstC, secCh - frstC)
'Debug.Print "_" & secStr & "_" 'OK
'extract third string:
frstC = secCh + Len("/IPE")
secCh = InStr(frstC, chngTxt, "F.CSV")
thrdStr = Mid(chngTxt, frstC, secCh - frstC)
'Debug.Print "_" & thrdStr & "_": 'Stop 'OK
'extract fourth string:
frstC = InStr(secCh + Len("F.CSV"), chngTxt, "files\IPE")
secCh = InStr(frstC + Len("files\IPE"), chngTxt, "F.CSV")
fourStr = Mid(chngTxt, frstC + Len("files\IPE"), secCh - (frstC + Len("files\IPE")))
'Debug.Print "_" & fourStr & "_": Stop 'OK
chngText = Replace(Replace(chngTxt, "/" & frstStr & "/", "/" & sh.Range("A1").value & "/"), "/" & secStr & "/", "/" & sh.Range("A2").value & "/")
chngText = Replace(Replace(chngText, thrdStr & "F.C", sh.Range("A3").value & "F.C"), fourStr & "F.C", sh.Range("A4").value & "F.C")
Debug.Print chngText 'just to visually check that the string to be changed has been correctly changed
'replace the changed string in the original file text:
strText = Replace(strText, chngTxt, chngText) 'the changed whole string!
'Debug.Print strText
Dim scriptFold As String, pathToFile As String
If Dir(sPath & "Scripts", vbDirectory) = "" Then MkDir sPath & "Scripts" 'create "Scripts" folder if it does not exist
pathToFile = sPath & "Scripts\" & sFile
Open pathToFile For Output As #1
Print #1, strText
Close #1
End Sub
After testing it and concluding that it fits what you want, you can overwrite the existing file in the last lines. I mean, pathToFile
must be sPath & sFile
. And, of course, in such a case the sequence using a different folder should be eliminated.
Upvotes: 1