VBScript RegEx : Replace Content - vbscript

I want to update the Unbound_DNS configuration file from a raw source but I can not get the desired result.
I would like to format each entry (each line):
address=/abc.com/0.0.0.0
To
local-zone: "abc.com" redirect
local-data: "abc.com 86400 IN A 0.0.0.0"
Here is what I did (thanks to hackoofr):
Option Explicit
Dim URL,Save2File,ws
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, """" & WScript.ScriptFullName & """ /elevate", "", "runas", 1
WScript.Quit
End If
URL = "https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt"
Set ws = CreateObject("wscript.Shell")
Save2File = ws.ExpandEnvironmentStrings("%Windir%\Temp\test")
Call Download(URL,Save2File)
'**********************************************************************************************
Sub Download(URL,Save2File)
Dim File,Line,BS,ws,RegExp
On Error Resume Next
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET",URL, False
File.Send
If err.number <> 0 then
Line = Line & vbcrlf & "Error Getting File"
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & vbcrlf &_
err.description
Line = Line & vbcrlf & "Source " & err.source
MsgBox Line,vbCritical,"Error getting file"
Err.clear
wscript.quit
End If
If File.Status = 200 Then
'**********************************************************************************************
' Replace content for use with the file service.conf of soft Unbound_DNS
'
' address=/abc.com/0.0.0.0 to local-zone: "abc.com" redirect
' local-data: "abc.com 3600 IN A 0.0.0.0"
'**********************************************************************************************
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"
File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")
Set RegExp = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set BS = CreateObject("ADODB.Stream")
Set ws = CreateObject("wscript.Shell")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile Save2File, 2
'**********************************************************************************************
' Clean cache DNS
'**********************************************************************************************
wshShell.run("cmd /c psexec \\ -s ipconfig /flushdns >> & hostName,TRUE")
ElseIf File.Status = 404 Then
MsgBox "UpdateHostname.vbs : File Not Found : " & File.Status,vbCritical,"UpdateHostname.vbs : Error File Not Found"
Else
MsgBox "UpdateHostname.vbs : Unknown Error : " & File.Status,vbCritical,"UpdateHostname.vbs : Error getting file"
End If
End Sub
'**********************************************************************************************
Thank you in advance for your help.
Edit 1:
The content does not change. File.ResponseBody returns the content correctly, but no modification by the regexp!

Replace the following code:
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"
File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")
Set RegExp = Nothing
with this:
Dim objReg, strTest, objMatches, objMatch
Set objReg = New RegExp
strTest = File.ResponseBody 'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
strTest = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
"local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&""""
Next
File.ResponseBody = strTest
set objReg = Nothing
Click for Regex Demo(in the demo, / is escaped by \)
Regex Explanation:
address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})
address=/ - matches address=/ literally
(.*?) - matches 0+ occurrences of any character(except a newline), as few as possible. The parenthesis are used to capture this match as group 1
/ - matches / literally
(\d{1,3}(?:\.\d{1,3}){3}) - matches a string of the pattern 12.222.212.33 and captures it in Group 2
Update:
Here is my final solution. From what I could understand from your code, you first get the response body from the server, modify and store the updated response in a file called test in the temp folder. Below is the code I have written to do the same thing. I have tested it on my system and the final output which gets stored in the C:\Windows\Temp\test.txt file looks correct as shown in the attached screenshot. Now, this may not be exactly what you want but you can get an idea from this. Store this code in a new vbs file and run it directly as it is.
Note: Since the response text from the server is very long, It takes a bit long to get executed. If you just want to see if it is working or not, uncomment the code inside the for loop. You will be able to see that you are getting the desired result for the first few URLs
Regex Demo
Option Explicit
Dim File, objReg, strTest, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send
If File.Status = 200 Then
Set objReg = New RegExp
strTest = File.responseText 'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
strReplace = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
"local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&"""" & vbCrLf
strTest = Replace(strTest,objMatch.Value,strReplace)
'Uncomment the following code to see the result for the 1st 5 URLs, if the whole thing is taking too long to get executed
'i=i+1
'If(i>5) Then
' Exit for
'End If
Next
set objReg = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set fso = CreateObject("scripting.filesystemobject")
Set outFile = fso.OpenTextFile(saveToFile,2,True)
outFile.Write strTest
outFile.Close
End If
Output:

Here is the update of the code that works very well based on the response of #Gurman and the comment of #Ansgar Wiechers. Thank you for your help
Option Explicit
Dim File, objReg, strTest, RegExp, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send
If File.Status = 200 Then
'**********************************************************************************************
' Replace content for use with the file service.conf of soft Unbound_DNS
'
' address=/abc.com/0.0.0.0 to local-zone: "abc.com" redirect
' local-data: "abc.com 86400 IN A 0.0.0.0"
'**********************************************************************************************
strTest = File.responseText
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})"
strReplace = "local-zone: ""$1"" redirect" & vbCrLf & "local-data: ""$1 86400 IN A $2"""
strTest = RegExp.Replace(strTest, strReplace)
Set RegExp = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set fso = CreateObject("scripting.filesystemobject")
Set outFile = fso.OpenTextFile(saveToFile,2,True)
outFile.Write strTest
outFile.Close
End If

Related

VBS to write multiple lines in textfile

I have a vbscript that checks for all users and checks for its last login time.
i open a file to write inside the file. However , i seem to have an issue where the it is writing only the last name it checks instead of all the names.
Result in the text should be :
user1
user2
user3
user4
However , this is my current result :
user4
How do i go about this?
I do apologize as i am mainly in C# and VBS is very new to me.
Option Explicit
Dim strComputer, objComputer, objUser, FSO, File
Const ForWriting = 2
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
For Each objUser In objComputer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile("C:\Users\sgbvx\Desktop\test\test.txt",ForWriting, True)
On Error Resume Next
Wscript.Echo objUser.Name & ", " & objUser.LastLogin
File.WriteLine objUser.Name
File.Write objUser.LastLogin
File.Close
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo objUser.Name & ", "
End If
On Error GoTo 0
Next
File.Close
So apparently my code has some arrangement issue that created a lot errors.
Here's my answer and an updated code for the above :
Option Explicit
Dim strComputer, objComputer, objUser, FSO, File
Const ForWriting = 2
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
Set FSO = CreateObject("Scripting.FileSystemObject")
//You may change the file name or directory//
Set File = FSO.OpenTextFile("C:\temp\test.txt",ForWriting, True)
//Start of ForEach loop , previously Set FSO and Set File was in this loop//
For Each objUser In objComputer
On Error Resume Next
//Writes Username and LastLogin detail//
File.Write objUser.Name & ", " & objUser.LastLogin
File.WriteLine
If (Err.Number <> 0) Then
On Error GoTo 0
//Writes only Username if LastLogin was not detected//
File.Write objUser.Name & ", "
File.WriteLine
End If
On Error GoTo 0
Next
File.Close

How to append to the end of a file?

I need a program the will check a file for a string input from the user and if the string exists then display a message but if it does not exist then add it to the list.
Here is what I have so far:
Const ForReading = 1
Dim strSearchFor
strSearchFor = inputbox("What is the url of the song?",,"")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("autoplaylist.txt", ForAppending)
do until objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine()
If InStr(strLine, strSearchFor) <> 0 then
Wscript.Echo "That song is already in the list."
Else
Wscript.Echo "That song was added to end of list."
End If
loop
objTextFile.Close
But I'm not sure how to add text to the file.
Also it displays a message every single line, there are like 3000 lines. Is there any way to fix this too?
How about this...
Const ForReading = 1
Const ForAppending = 8
Dim strSearchFor, strFileText, strFileName
strSearchFor = inputbox("What is the url of the song?",,"")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFileName = "autoplaylist.txt"
' Check file exists and ReadAll
' ------------------------------
If objFSO.FileExists(strFileName) Then
On Error Resume Next
With objFSO.OpenTextFile(strFileName, ForReading)
strFileText = .ReadAll
.Close
End With
If Err.Number <> 0 Then
WScript.Echo "File access error"
WScript.Quit
End If
On Error Goto 0
Else
Wscript.Echo "File does not exists"
Wscript.Quit
End If
' Search for input string
' If found append user input
' ----------------------------
If Instr(strFileText, strSearchFor) = 0 Then
With objFSO.OpenTextFile(strFileName, ForAppending)
.WriteLine(strSearchFor)
.Close
End With
Wscript.Echo strSearchFor & " was not found in " & strFileName & " and has been appended"
Else
Wscript.Echo strSearchFor & " has been found in " & strFileName
End If
WScript.Quit

Replace a specific string with the filename?

How to replace a specific string with the filename? Example: I have several files with different names (like: Test.asp, Constant.asp, Letter.asp, etc.) within a subfolder that contain the text "ABC123". I would like to replace the "ABC123" in each file with the filename.
Below is the code I have that finds string and replaces it with a specific string but it doesn't do the job that I listed above.
Option Explicit
Dim objFilesystem, objFolder, objFiles, objFile, tFile, objShell, objLogFile,objFSO, objStartFolder, colFiles
Dim SubFolder, FileText, bolWriteLog, strLogName, strLogPath, strCount, strCount2, strOldText, strNewText, strEXT
bolWriteLog = True
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Set objFilesystem = WScript.CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strLogName = "log.txt"
strLogPath = "C:\" & strLogName
strCount = 0
strCount2 = 0
strOldText = "ABC123"
strNewText = ""
strEXT = "asp"
'Initialize log file
If bolWriteLog Then
On Error Resume Next
Set objLogFile = objFileSystem.OpenTextFile(strLogPath, 2, True)
WriteLog "############### Start Log ##################"
If Not Err.Number = 0 Then
MsgBox "There was a problem opening the log file for writing." & Chr(10) & _
"Please check whether """ & strLogPath & """ is a valid file and can be openend for writing." & _
Chr(10) & Chr(10) & "If you're not sure what to do, please contact your support person.", vbCritical, "Script Error"
WScript.Quit
End If
On Error Goto 0
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "D:\MyFolder"
Set objFolder = objFSO.GetFolder(objStartFolder)
WScript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile In colFiles
'WScript.Echo objFile.Name
' Now we have an exception for all files that can not be opened in text modus: all extensions such as "exe" should be listed upfront.
ReplaceText(objFile)
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ReplaceText(objFile)
If InStr(1, strEXT, Right(LCase(objFile.Name), 3)) = 0 Or objFile.Size = 0 Then
Else
strCount = strCount + 1
WriteLog("Opening " & objFile.Name)
Set tFile = objFile.OpenAsTextStream(ForReading, TriStateUseDefault)
FileText = tFile.ReadAll
tFile.Close
If InStr(FileText, strOldText) Then
WriteLog("Replacing " & strOldText & " with " & strNewText & ".")
FileText = Replace(FileText, strOldText, strNewText)
WriteLog("Text replaced")
Else
WriteLog(strOldText & " was not found in the file.")
strCount2 = strCount2 + 1
End If
Set tFile = objFile.OpenAsTextStream(ForWriting, TriStateUseDefault)
tFile.Write FileText
tFile.Close
FileText = ""
strCount = 0
strCount2 = 0
End If
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
'WScript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
'WScript.Echo objFile.Name
ReplaceText(objFile)
Next
ShowSubFolders Subfolder
Next
End Sub
WriteLog "############### EndLog ##################"
WScript.Echo "Script Complete"
objShell.Run "C:\" & strLogName
'Clear environment and exit
On Error Resume Next
Set tFile = Nothing
Set objFile = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objLogFile = Nothing
Set objFilesystem = Nothing
Set objShell = Nothing
WScript.Quit
'Subs and functions ********** DO NOT EDIT ***************
Sub WriteLog(sEntry)
If bolWriteLog Then objLogFile.WriteLine(Now() & ": Log: " & sEntry)
End Sub
I can give you a one line Ruby solution, should be not too difficult to translate that in Python but somewhat more extensive in VbScript I am afraid. First a generic search and replace version.
ARGV[0..-3].each{|f| File.write(f, File.read(f).gsub(ARGV[-2],ARGV[-1]))}
Save it in a script, eg replace.rb
You start in on the command line (here cmd.exe) with
replace.rb *.txt <string_to_replace> <replacement>
broken down so that I can explain what's happening but still executable
# ARGV is an array of the arguments passed to the script.
ARGV[0..-3].each do |f| # enumerate the arguments of this script from the first to the last (-1) minus 2
File.write(f, # open the argument (= filename) for writing
File.read(f) # open the argument (= filename) for reading
.gsub(ARGV[-2],ARGV[-1])) # and replace all occurances of the beforelast with the last argument (string)
end
And finally your request to replace ABC123 with the filename.
Of course tested and working
ARGV[0..-1].each{|f| File.write(f, File.read(f).gsub('ABC123', f))}
Contents of one of my testfiles (1.txt) after executing
test phrase
1.txt
EDIT
I see you want subfolder recursion on a fixed folder, no problem
Dir['**/*'].each{|f| File.write(f, File.read(f).gsub('ABC123', f)) unless File.directory?(f) }

Vbscript Website Content, SelectAll Copy and Past into a Notepad *Help*

I got the code to copy the contents of a website into notepad:
With CreateObject("InternetExplorer.Application")
.Visible = False
.Navigate "https://example.com"
Do Until .ReadyState = 4
Wscript.Sleep 100
Loop
For Each Tag In .Document.GetElementsByTagName("script")
Tag.OuterHtml = ""
Next
For Each Tag In .Document.GetElementsByTagName("noscript")
Tag.OuterHtml = ""
Next
Content = .Document.GetElementsByTagName("body")(0).InnerText
Do While InStr(Content, vbCrLf & vbCrLf)
Content = Replace(Content, vbCrLf & vbCrLf, vbCrLf)
Loop
ShowInNotepad Content
.Quit
End With
Sub ShowInNotepad(Content)
With CreateObject("Scripting.FileSystemObject")
TempPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%TEMP%") & "\" & .GetTempName
With .CreateTextFile(TempPath, True, True)
.WriteLine (Content)
.Close
End With
CreateObject("WScript.Shell").Run "notepad.exe " & TempPath, 1, True
.DeleteFile (TempPath)
End With
End Sub
I am stuck with above script to save the text as file.txt.
Please help.
Try something like that :
Option Explicit
Dim LogFile,Ws,Tag,Content
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
Set Ws = CreateObject("wscript.Shell")
With CreateObject("InternetExplorer.Application")
.Visible = False
.Navigate "https://example.com"
Do Until .ReadyState = 4
Wscript.Sleep 100
Loop
For Each Tag In .Document.GetElementsByTagName("script")
Tag.OuterHtml = ""
Next
For Each Tag In .Document.GetElementsByTagName("noscript")
Tag.OuterHtml = ""
Next
Content = .Document.GetElementsByTagName("body")(0).InnerText
Do While InStr(Content, vbCrLf & vbCrLf)
Content = Replace(Content, vbCrLf & vbCrLf, vbCrLf)
Loop
WriteLog Content,LogFile
.Quit
End With
Ws.Run LogFile
'*******************************************************************
Sub WriteLog(strText,LogFile)
Dim fso,ts
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(LogFile,ForWriting,True,-1)
ts.WriteLine strText
ts.Close
End Sub
'******************************************************************

Using VBS to Backup a file

I managed to find this script to use and backup my files, this is a little more complicated then I need it to be.
I do not need to enter a backup path - from and too every time I run it however this is a handy option for other projects but I would like to backup from a set file path and save to a set file path to save time.
The other issue with this script is the Cancel button does not work, this is an issue I have had before and fixed but I cannot remember how to make the Cancel button function.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSourceFolder = InputBox("Enter the Source directory path you wish to backup")
strDestFolder = InputBox("Enter the Destination directory path you wish to backup your Data to... (C:/Backup, //Backup-Server/Remotebackup")
Wscript.Echo "Click (OK) to start the Backup!"
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
Function CopyFolderStructure(strSource, strDestination, strExcludedExt)
Const OVER_WRITE_FILES = True
Dim objDir, objFolder, objFiles, strCurExt, intX, arrExt, blnExclude
Set objDir = objFSO.GetFolder(strSource)
If Not objFSO.FolderExists(strDestination & "\" & objDir.Name) Then
objFSO.CreateFolder(strDestination & "\" & objDir.Name)
End If
If Not IsNoData(strExcludedExt) Then
arrExt = Split(strExcludedExt, ",")
blnExclude = False
End If
For Each objFiles In objFSO.GetFolder(strSource).Files
If Not IsNoData(strExcludedExt) Then
strCurExt = objFSO.GetExtensionName(objFiles.Name)
For intX = 0 To UBound(arrExt)
If LCase(strCurExt) = arrExt(intX) Then
blnExclude = True
Exit For
Else
blnExclude = False
End If
Next
If Not blnExclude Then
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Else
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Next
For Each objFolder In objFSO.GetFolder(strSource).SubFolders
CopyFolderStructure objFolder.Path, strDestination & "\" & objDir.Name, strExcludedExt
Next
End Function
Function BrowseForFolderDialogBox(strTitle)
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = &H0001
Dim objShellApp
Dim objFolder
Dim objFldrItem
Dim objPath
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.BrowseForFolder(WINDOW_HANDLE, strTitle , NO_OPTIONS)
If IsNoData(objFolder) Then
WScript.Echo "You choose to cancel. This will stop this script."
Wscript.Quit
Else
Set objFldrItem = objFolder.Self
objPath = objFldrItem.Path
BrowseForFolderDialogBox = objPath
Set objShellApp = Nothing
Set objFolder = Nothing
Set objFldrItem = Nothing
End If
End Function
Function IsNoData(varVal2Check)
On Error Resume Next
If IsNull(varVal2Check) Or IsEmpty(varVal2Check) Then
IsNoData = True
Else
If IsDate(varVal2Check) Then
IsNoData = False
Elseif varVal2Check = "" Then
IsNoData = True
ElseIf Not IsObject(varVal2Check) Then
IsNoData = False
Else
IsNoData = False
End If
End If
End Function
Wscript.Echo "Backup Has Completed Successfully"
Next code snippet could help (see Arguments Property (WScript Object), InputBox Function and MsgBox Function reference). Note that the Echo method behaves differently depending on which WSH engine you are using.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Dim iBut, sRes, sMes, objArgs
sRes = Wscript.ScriptName
sMes = vbCRLF & "(click (Cancel) button to discard)"
Set objArgs = WScript.Arguments
If objArgs.Count > 1 Then
strSourceFolder = objArgs( 0)
strDestFolder = objArgs( 1)
Else
strSourceFolder = "C:/DataToBackup"
strDestFolder = "D:/Backup"
strSourceFolder = InputBox( "Path you wish to backup" & sMes _
, "Source directory", strSourceFolder)
sRes = sRes & vbNewLine & "strSourceFolder """ & strSourceFolder & """"
If strSourceFolder = "" Then
strDestFolder = ""
Else
strDestFolder = InputBox( "Path you wish to backup your Data to" & sMes _
, "Destination directory", strDestFolder)
sRes = sRes & vbNewLine & "strDestFolder """ & strDestFolder & """"
End If
End If
If strDestFolder = "" Then
sRes = sRes & vbNewLine & "Backup Cancelled!"
Wscript.Echo sRes
Wscript.Quit
Else
iBut=MsgBox(sRes & sMes, vbOKCancel + vbQuestion _
, "Click (OK) to start the Backup!")
If iBut <> vbOK Then Wscript.Quit
End If
'''' for debugging only:
Wscript.Quit '''' for debugging only:
'''' for debugging only:
Set objFSO = CreateObject("Scripting.FileSystemObject")
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
'''''' and so on...

Resources