Script help needed editing ini file - vbscript

I'm trying to edit one line in an ini file. DeviceName=APPLE to DeviceName="The User Input". I have it almost there from bits and pieces across the internet. It works except the end result is my file jwalk.ini with the correct entry after user input but the ini file has been renamed to just .ini, no jwalk before ini. I must be missing something. The file jwalk.ini already will exist I just need to edit it with the new user input and leave the file named the same.
My Script:
Const ForReading = 1
Const ForWriting = 2
Const OpenAsASCII = 0
Const CreateIfNotExist = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open existing file for read access.
strInput = "c:\MyFolder\jwalk.ini"
Set objInput = objFSO.OpenTextFile(strInput, ForReading)
' Prompt for device name.
strDeviceName = InputBox("Enter devicename", "JWalk PC Name or Session Name")
' Specify the new file name.
strOutput = "c:\MyFolder\" & strComputer & ".ini"
' Create new file with write access.
Set objOutput = objFSO.OpenTextFile(strOutput, _
ForWriting, CreateIfNotExist, OpenAsASCII)
' Process input file.
Do Until objInput.AtEndOfStream
' Read next line of the input file.
strLine = objInput.ReadLine
' Search for line to be modified.
' Make search case insensitive.
If (InStr(LCase(strLine), "devicename=") > 0) Then
' Replace the line.
' You could also modify the line.
strLine = "devicename=" & strDeviceName
End If
' Write line to the output file.
objOutput.WriteLine strLine
Loop
' Clean up.
objInput.Close
objOutput.Close
' Delete the original file.
objFSO.DeleteFile(strInput)
Any ideas? Thanks.

If you'd have used Option Explicit, you'd have been told that
strOutput = "c:\MyFolder\" & strComputer & ".ini"
uses the undefined/uninitialized variable strComputer.

Here you are passing "strComputer" as a var, but never set it's value:
' Specify the new file name.
strOutput = "c:\MyFolder\" & strComputer & ".ini"
If you are trying to get the computer name you could consider this:
' Specify the new file name.
strOutput = "c:\MyFolder\" & GetComputerName() & ".ini"
Function GetComputerName()
Dim ob
Set ob = Wscript.CreateObject("Wscript.Network")
GetComputerName = ob.ComputerName
Set ob = nothing
End Function

Related

Using vbscript to save OpenOffice/Spreadsheet csv file [duplicate]

I'm trying to write a script for a while now but it seems that one part of it just does not work.
Situation: I need a VB script that can use any LibreOffice (/ OpenOffice) Calc (3.5.4 in my case) installation on any Windows XP or 7 system for export of xls to csv (as many csv files as there are sheets in the xls). It has to be VBS and LibreOffice in this case. No macro installed, everything controlled externally by vbscript.
So, first step was to use the macro recorder in order to get the right filter settings.
StarBasic macro:
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = "file:///C:/Users/lutz/Desktop/test.csv"
args1(1).Name = "FilterName"
args1(1).Value = "Text - txt - csv (StarCalc)"
args1(2).Name = "FilterOptions"
args1(2).Value = "9,0,76,1,,0,false,true,true"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
This macro (in LibreOffice) writes a CSV of the current sheet (after LO telling me that only the current sheet will be saved), encoding UTF-8, field separator Tab, no text separator. This works.
I tried to get this to work in my vbs but it absolutely did not. So I searched a lot in OpenOffice and LibreOffice forums, here at stackoverflow, etc. and used another method.
Problem: Everytime it saves the file(s) it saves them as ODS, no matter which filter or filter options I use. It always saves to zipped OpenDocument. I tried numerous Filters, even PDF. It seems that it works with pdf when I only use the FilterName property but somehow it doesn't work anymore. And I don't know why.
The code:
' Scripting object
Dim wshshell
' File system object
Dim objFSO
' OpenOffice / LibreOffice Service Manager
Dim objServiceManager
' OpenOffice / LibreOffice Desktop
Dim objDesktop
' Runcommand, if script does not run with Cscript
Dim runcommand
Dim Path
Dim Savepath
Dim Filename
Dim url
Dim args0(0)
Dim args1(3)
' Create File system object
Set wshshell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
' If not run in cscript, run in cscript
if instr(1, wscript.fullname, "cscript.exe")=0 then
runcommand = "cscript //Nologo xyz.vbs"
wshshell.run runcommand, 1, true
wscript.quit
end if
' If files present, run Calc
If objFSO.GetFolder(".").Files.Count>0 then
Set objServiceManager = WScript.CreateObject("com.sun.star.ServiceManager")
' Create Desktop
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
else
' If no files in directory
wscript.echo "No files found!"
wscript.quit
End If
on error resume next
bError=False
For each File in objFSO.GetFolder(".").Files
if lcase(right(File.Name,3))="xls" then
' Access file
url = ConvertToURL(File.Path)
objDesktop = GlobalScope.BasicLibraries.loadLIbrary( "Tools" )
Set args0(0) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Set objDocument = objDesktop.loadComponentFromURL(url, "_blank", 0, args0 )
' Read filenames without extension or path
Path = ConvertToURL( File.ParentFolder ) & "/"
Filename = objFSO.GetBaseName( File.Path )
Savepath = ConvertToURL( File.ParentFolder )
' set arguments
Set args1(0) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Set args1(1) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Set args1(2) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
sFilterName = "Text - txt - csv (StarCalc)"
sFilterOptions = "9,0,76,1,,0,false,true,true"
sOverwrite = True
Set args1(0) = MakePropertyValue( "FilterName", sFilterName )
Set args1(1) = MakePropertyValue( "FilterOptions", sFilterOptions )
Set args1(2) = MakePropertyValue( "Overwrite", sOverwrite )
' Save every sheet in separate csv file
objSheets = objDocument.Sheets
For i = 0 to objDocument.Sheets.getcount -1
objSheet = objDocument.Sheets.getByIndex(i)
Call objDocument.CurrentController.setActiveSheet(objSheet)
Call objDocument.storeToURL( ConvertToURL( File.ParentFolder & "\" & Filename & "_" & objDocument.sheets.getByIndex(i).Name & ".csv" ), args1 )
Next
' Close document
objDocument.close(True)
Set objDocument = Nothing
Path = ""
Savepath = ""
Filename = ""
Else
End If
Next
' Close / terminate LibreOffice
objDesktop.terminate
Set objDesktop = nothing
Set objServiceManager = nothing
The function ConvertToUrl is not listed here. It is a vbscript function that converts Windows paths to URL paths (file:/// etc.). It is tested and works.
What I also tried:
Saving in ods first (StoreAsUrl) then try to save in different format.
Use MakePropertyValue( "SelectionOnly", true )
None of that worked nor did it combined. I used http://extensions.services.openoffice.org/de/project/OOcalc_multi_sheets_export as a source of inspiration. But it is a macro, not direct access from an external vb script.
It seems that the problem is a general one with StoreToUrl or the properties / arguments:
Even FilterName "writer_pdf" or "Calc MS Excel 2007 XML" don't work. Problem is: I don't know what's the culprit here. The settings that the macro recorder uses are the same and if one uses the macro directly in LibreOffice it works.
Maybe someone knows what needs to get changed in the code or how I can get the dispatcher used in the macro to work.
Thank you for your help in advance!
Ok, I found the solution after days of research and tiny little information scattered everywhere. I hope that this code will serve someone well:
' Variables
Dim wshshell ' Scripting object
Dim oFSO ' Filesystem object
Dim runcommand ' Runcommand, if not run in Cscript
Dim oSM ' OpenOffice / LibreOffice Service Manager
Dim oDesk ' OpenOffice / LibreOffice Desktop
Dim oCRef ' OpenOffice / LibreOffice Core Reflections
Dim sFileName ' Filename without extension
Dim sLoadUrl ' Url for file loading
Dim sSaveUrl ' Url for file writing
Dim args0(0) ' Load arguments
' Create file system object
Set wshshell = CreateObject("Wscript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' If not run in cscript, run in cscript
if instr(1, wscript.fullname, "cscript.exe")=0 then
runcommand = "cscript //Nologo xyz.vbs"
wshshell.run runcommand, 1, true
wscript.quit
end if
' If there are files, start Calc
If oFSO.GetFolder(".").Files.Count>0 then
' If no LibreOffice open -> run
Set oSM = WScript.CreateObject("com.sun.star.ServiceManager")
' Create desktop
Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
Set oCRef = oSM.createInstance( "com.sun.star.reflection.CoreReflection" )
else
' If no files in directory
wscript.quit
End If
' Error handling
on error resume next
' CSV settings for saving of file(s)
sFilterName = "Text - txt - csv (StarCalc)"
sFilterOptions = "9,0,76,1,,0,false,true,true"
sOverwrite = True
' load component for file access
oDesk = GlobalScope.BasicLibraries.loadLIbrary( "Tools" )
' load argument "hidden"
Set args0(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Set args0(0) = MakePropertyValue("Hidden", True)
For each oFile in oFSO.GetFolder(".").Files
if lcase(right(oFile.Name,3))="xls" then
' open file
sLoadUrl = ConvertToURL(oFile.Path)
Set oDoc = oDesk.loadComponentFromURL(sLoadUrl, "_blank", 0, args0 )
' read filename without extension or path
sFileName = oFSO.GetBaseName( oFile.Path )
' save sheets in CSVs
For i = 0 to oDoc.Sheets.getcount -1
oActSheet = oDoc.CurrentController.setActiveSheet( oDoc.Sheets.getByIndex(i) )
sSaveUrl = ConvertToURL( oFile.ParentFolder & "\" & sFileName & "_" & oDoc.sheets.getByIndex(i).Name & ".csv" )
saveCSV oSM, oDoc, sSaveUrl, sFilterName, sFilterOptions, sOverwrite
Next
' Close document
oDoc.close(True)
Set oDoc = Nothing
Set oActSheet = Nothing
sFileName = ""
sLoadUrl = ""
sSaveUrl = ""
Else
End If
Next
' Close LibreOffice
oDesk.terminate
Set oDesk = nothing
Set oSM = nothing
Function ConvertToURL(sFileName)
' Convert Windows pathnames to url
Dim sTmpFile
If Left(sFileName, 7) = "file://" Then
ConvertToURL = sFileName
Exit Function
End If
ConvertToURL = "file:///"
sTmpFile = oFSO.GetAbsolutePathName(sFileName)
' replace any "\" by "/"
sTmpFile = Replace(sTmpFile,"\","/")
' replace any "%" by "%25"
sTmpFile = Replace(sTmpFile,"%","%25")
' replace any " " by "%20"
sTmpFile = Replace(sTmpFile," ","%20")
ConvertToURL = ConvertToURL & sTmpFile
End Function
Function saveCSV( oSM, oDoc, sSaveUrl, sFilterName, sFilterOptions, sOverwrite )
' Saves the open document resp. active sheet in a single file
Dim aProps( 2 ), oProp0, oProp1, oProp2, vRet
' Set filter name and write into property array
Set oProp0 = oSM.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
oProp0.Name = "FilterName"
oProp0.Value = sFilterName
Set aProps( 0 ) = oProp0
' Set filter options and write into property array
Set oProp1 = oSM.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
oProp1.Name = "FilterOptions"
oProp1.Value = sFilterOptions
Set aProps( 1 ) = oProp1
' Set file overwrite and write into property array
Set oProp2 = oSM.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
oProp2.Name = "Overwrite"
oProp2.Value = sOverwrite
Set aProps( 2 ) = oProp2
' Save
vRet = oDoc.storeToURL( sSaveUrl, aProps )
End Function
I hope that at least this small contribution from me helps others.

How to search a folder name at a particular location, with a wildcard character and store in a variable?

This is the script I have written and I have mentioned the issue I am facing below.
Option Explicit
Dim FSO, WSH, RunDefaultProfile
Dim PF, UPF
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")
UPF = Wsh.ExpandEnvironmentStrings("%userprofile%")
PF = Wsh.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
RunDefaultProfile = """" & PF & "\Mozilla Firefox\firefox.exe" & """" & _
" -CreateProfile default"
' Create the Default profile if it not exists
If NOT FSO.FolderExists (UPF & "\AppData\Roaming\Mozilla\Firefox\Profiles\c4ssju9t.default") Then
WSH.Run RunDefaultProfile
End if
Now the challenge I am facing is, Firefox creates a random .default folder on each machine and I can't use my If NOT FSO.FolderExists condition. Also I want store the .default folder name if already exists. I will use that to run other commands and expand my script.
The path to the profile is stored in the file %APPDATA%\Mozilla\Firefox\profiles.ini. You can read it from the file like this:
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh = CreateObject("WScript.Shell")
configdir = sh.ExpandEnvironmentStrings("%APPDATA%\Mozilla\Firefox")
inifile = fso.BuildPath(configDir, "profiles.ini")
If fso.FileExists(inifile) Then
Set f = fso.OpenTextFile(inifile)
Do Until f.AtEndOfStream
line = f.ReadLine
If Left(line, 5) = "Path=" Then
relPath = Split(line, "=")(1)
Exit Do
End If
Loop
f.Close
End If
This will get the first profile path from the INI file (if it exists).
You can then use it like this to create a missing profile:
profileExists = False
If Not IsEmpty(relPath) Then
profile = fso.BuildPath(configdir, relPath)
profileExists = fso.FolderExists(profile)
End If
If Not profileExists Then sh.Run RunDefaultProfile

Windows script host error 800A0046

I'm receiving the following error when I run my program:
Script: C: My Folder\Tracking Macro.vbs
Line: 70
Char: 1
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
Here is the code.
' Set constants for reading, writing, and appending files
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Sets up the object variables.
Dim objExcel, objFSO, objTextFile, objCSVFile
' Sets up the string variables.
Dim strTextFile, strHeadLine, strTextLine, strCSVFile
' Sets up the all the string variables for the program.
Dim Desktop, todaysDate, usageDate, myDay, myMonth, myYear
'This creates the required Objects
Set objExcel = CreateObject("Excel.application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Desktop = WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\" & "Desktop"
' Set date for date stamp in file name and sheet name
todaysDate = Date()
myMonth = Month(todaysDate)
If Len(myMonth)=1 Then myMonth="0" & myMonth
myDay = Day(todaysDate)
If Len(myDay)=1 Then myDay="0" & myDay
myYear = Right(Year(todaysDate), 2)
usageDate = myMonth & myDay & myYear
' Set up the origin and destination files
strTextFile = (Desktop & "\MacroTracker.txt")
strCSVFile = "C: My Folder\TrackingTesting" & usageDate & ".csv"
strHeadLine = "Macro Name,User ID,Ran At,Contracted Rate,BHVN,Set Number,Provider TIN,Billed Charge,Service Code"
Set objTextFile = objFSO.OpenTextFile(strTextFile)
' Read the entire origin file
Do Until objTextFile.AtEndOfStream
strTextLine = objTextFile.ReadLine
Loop
If (objFSO.FileExists(strCSVFile)) Then
' Create object for appending current TXT file to CSV file
Set objCSVFile = objFSO.OpenTextFile(strCSVFile, ForAppending, True)
' Write an append line of data to the CSV file
objCSVFile.WriteLine strTextLine
Else
' Create CSV file to write to with today's date
Set objCSVFile = objFSO.CreateTextFile(strCSVFile, True)
' Create object for appending current TXT file to CSV file
Set objCSVFile = objFSO.OpenTextFile(strCSVFile, ForAppending, True)
' Write initial header for the CSV file
objCSVFile.WriteLine strHeadLine
' Write an append line of data to the CSV file
objCSVFile.WriteLine strTextLine
End If
' Wait for file to be written to
Wscript.Sleep 600
' Delete origin file to prevent user tampering
objFSO.DeleteFile(strTextFile)
Line 70 is the very last line where I'm deleting the text file. According to every help site I've seen, this is EXACTLY how it should be typed. I checked the permissions of the file...I have full control, so I should be able to delete it. It's only meant to be a temp file, not something that stores info for long periods of time.
I've checked Microsoft and all other help sites for the error code and have not found any solutions that can help me. I'm hoping someone may have ran into a similar instance and found a resolution.
Your file is still open. You need to add this:
objTextFile.Close
somewhere before you try to delete it. I would put it right after you're done using the file.

Create a text file with the logged in user as its filename

I have this script that is creating and updating a text file called Machine.txt and populates it with a list of lines which have this format (username, time and date when the script ran).
I’m running this at logon.
What I want to do is to create a new text file for each user who logs in.
Example, if user is called fred I want the script to create fred.txt.
Any ideas?
Script been used is shown below i have replaced file location and name with "filepath and name"
thnak you for any help you can provide.
Set WSHShell = WScript.CreateObject ("WScript.Shell")
Set WSHNetwork = WScript.CreateObject ("WScript.Network")
Set WSHSysEnv = WSHShell.Environment ("PROCESS")
On Error Resume Next
' Check what OS is being used
Dim valOS
valOS = WSHShell.RegRead ("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
Dim valPath, valLocation
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objEnv = WshShell.Environment("Process")
valMachine = objEnv("COMPUTERNAME")
valDate = date
valTime = time
' This section of the script look for a hidden file on a users private share. This file is used to store a list of
' machines that a client has logged onto and the date and time that they logged on
Set oFSO = CreateObject ("Scripting.FileSystemObject")
If oFSO.FileExists ("filepath and name") Then ' If this file exists open the file for appending
Set oAppend = oFSO.OpenTextFile ("filepath and name",8) ' Open the text file for appending
oAppend.Writeline valMachine & "," & valDate & "," & valTime ' Write the machine name, date and time the the user logged onto the client
oAppend.close ' Close the text file connection
valPath = ""
valDate = ""
valTime = ""
Else
Set oStream = oFSO.CreateTextFile ("filepath and name") ' Create the file
Set objFile = oFSO.GetFile ("filepath and name") ' Attach to the file
objFile.Attributes = 2 ' Change the file attribute to hidden
oStream.Writeline valMachine & "," & valDate & "," & valTime ' Write the machine name, date and time the the user logged onto the client
oStream.close ' Close the text file connection
valPath = "" ' Clear the valPath variable
valDate = "" ' Clear the valDate variable
valTime = "" ' Clear the valTime variable
End If
wscript.quit
Try this:
Dim objNetwork
Dim userName
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.UserName
Assign userName as your file name with a .txt extension

Find and replace multiple file in vbs

I am trying to implement a find and replace for all files in a folder using a vbs script, here is what I have so far
Dim fso,folder,files,oldFileContents,newFileContents,FIND,REPLACE
FIND = "textToBeReplaced"
REPLACE = "localhost"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("HTML")
Set files = folder.Files
For each item In files
oldFileContents = GetFile(item.Path)
newFileContents = replace(oldFileContents,FIND,REPLACE,1,-1,1)
WriteFile FileName,newFileContents
Next
but when I try to run it I get and error, "Type Mismatch: 'GetFile'", what am I doing wrong?
The problem should be solved with code like:
' Constants Mr Gates forgot (but cf. vbTextCompare)
Const ForReading = 1
Const ForWriting = 2
' Configuration constants
Const csFind = "pdf"
Const csRepl = "puf"
' Dim & init for vars needed on *this* level
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim sTDir : sTDir = oFS.GetAbsolutePathName("..\data\test")
Dim oFile
For Each oFile In oFS.GetFolder(sTDir).Files
WScript.Echo "looking at", oFile.Name
' Dim & init for vars needed on *this* level
Dim sContent : sContent = goFS.GetFile(oFile.Path)
' For Skytunnels and other air-coders
WScript.Echo "content is not", sContent
' you got oFile, so use it; no need for .GetFile()
sContent = oFile.OpenAsTextStream(ForReading).ReadAll()
WScript.Echo "qed! content is", sContent
' Replace(expression, find, replacewith[, start[, count[, compare]]])
' don't use magic numbers; vbTextCompare is even pre-defined
sContent = Replace(sContent, csFind, csRepl, 1, -1, vbTextCompare)
WScript.Echo "new content", sContent
oFile.OpenAsTextStream(ForWriting).Write sContent
sContent = oFile.OpenAsTextStream(ForReading).ReadAll()
WScript.Echo "new content straight from file", sContent
WScript.Echo "------------------"
Next
output:
...
------------------
looking at 0000000000012345.20120302.pdf
content is not E:\trials\SoTrials\answers\9117277\data\test\0000000000012345.20120302.pdf
qed! content is This is the content of 0000000000012345.20120302.pdf
new content This is the content of 0000000000012345.20120302.puf
new content straight from file This is the content of 0000000000012345.20120302.puf
Important points:
Don't use a Dim-all-vars-ever-used-line at the top of your script
Avoid creation of unnecessary vars (folder, files, *contents), use
the vars you have properly (item==oFile)
.GetFile() returns a File object, not the file's content
You missed out the fso. on
oldFileContents = fso.GetFile(item.Path)
and
fso.WriteFile FileName,newFileContents
EDIT: as per discussion below, please note this answer was only meant to show where your error was occurring. It was assumed that your intent was to develop your code further once your got past this error, which if so, I’m sure you’ve already seen Ekkehard has provided some very helpful guidance on his answer.

Resources