I am a VBS noob so forgive the simple question. I have created a script to open an .xlsx document on my desktop, and run various actions. I would like to port the script to other users. That said, how can I create a path that will work for all users, i.e. a user desktop variable. In PowerShell I could do '$env:USERPROFILE + '\Desktop'' and it would address the current user's desktop. Is there a VBS equivalent?
What I have so far:
Set xl = CreateObject("Excel.application")
xl.Application.Visible = True
Dim wb1
Set wb1 = xl.Application.Workbooks.Open("C:\Users\Username\Desktop\Missed_Scans\Reports\Report.xlsx")
Dim wb2
Set wb2 = xl.Workbooks.Add
wb1.Sheets("Incomplete_ASINs").Range("$A$1:$J$52951").AutoFilter 1, "SDF8"
wb1.Sheets("Incomplete_ASINs").Columns("B:D").Copy
wb2.Worksheets(1).Paste
wb2.Worksheets(1).Rows(1).AutoFilter
wb2.SaveAs "C:\Users\Username\Desktop\Missed_Scans\Reports\Missed_Scans.xlsx", 51, , , , False
wb2.Close
wb1.Close False
xl.Quit
Set xl = Nothing
Lines 5 and 13 are the areas that need to use some type of user environment variable. I understand that environ("UserName") can provide the username, but I am not sure how to incorporate it.
Just use ExpandEnvironmentStrings:
Set osh = CreateObject("wscript.shell")
xl.workbooks.open osh.ExpandEnvironmentStrings("%userprofile%\Desktop\Missed_Scans\Reports\Report.xlsx")
For line 13 also, you can write something like:
wb2.SaveAs osh.ExpandEnvironmentStrings("%userprofile%\Desktop\Missed_Scans\Reports\Missed_Scans.xlsx"), 51, , , , False
Update:
Note: I did not make any changes to any logic. Just removed the errors.
Set xl = CreateObject("Excel.application")
xl.Application.Visible = True
Dim wb1
Set osh = CreateObject("wscript.shell")
Set wb1 = xl.Workbooks.Open(osh.ExpandEnvironmentStrings("%userprofile%\Desktop\Missed_Scans\Reports\Report.xlsx"))
Dim wb2
Set wb2 = xl.Workbooks.Add
wb1.Sheets("Incomplete_ASINs").Range("$A$1:$J$52951").AutoFilter 1, "SDF8"
wb1.Sheets("Incomplete_ASINs").Columns("B:D").Copy
wb2.Worksheets(1).Paste
wb2.Worksheets(1).Rows(1).AutoFilter
wb2.SaveAs osh.ExpandEnvironmentStrings("%userprofile%\Desktop\Missed_Scans\Reports\Missed_Scans.xlsx"), 51, , , , False
wb2.Close
wb1.Close False
xl.Quit
Set xl = Nothing
Related
I am trying to search through Word documents and try to find a certain character. The ± character to be precise. The code can find the character because I have it print to screen if it found it. But it is unable to replace the character.
I have even tried searching for a random string I knew was in the files such as "3" and replacing it with something random such as "dog". But nothing works. It still finds the characters but does not replace.
Option Explicit
Dim objWord, objDoc, objSelection, oFSO, folder, jj, file
Set objWord = CreateObject("Word.Application")
objWord.Visible = False: objWord.DisplayAlerts = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set folder = oFSO.GetFolder("C:\Users\Desktop\myFolder")
For Each file In folder.Files
objWord.Documents.Open file.path, False, True ' path, confirmconversions, readonly
Set objDoc = objWord.ActiveDocument
Set objSelection = objWord.Selection
objSelection.Find.Forward = True
objSelection.Find.MatchWholeWord = False
objSelection.Find.Text = ChrW(177)
objSelection.Find.Replacement.Text = "ChrW(177)"
objSelection.Find.Execute
If objSelection.Find.Found = True then
Wscript.echo "Character Found"
End If
objDoc.close
Next
objWord.Quit
The problem is that the code in the question doesn't specify that a replacement should take place. This is set in the Execute method, as a parameter.
Since this is VBScript rather than VBA it's not possible to use the enumerations (such as wdReplaceAll). Instead, it's necessary to specify the numeric equivalent of an enumeration. VBA without enumerations...
objSelection.Find.Execute Replace:=2, Forward:=True, Wrap:=0
However, VBScript doesn't accept named arguments, so all the arguments need to be specified by position, with "empty commas" if nothing should be specified.
objSelection.Find.Execute , , , , , , , 0, , , 2
To discover the numeric equivalent consult either the VBA Object Library (F2 in the VBA Editor), the Language Reference or use the Immediate Window (Ctrl+G) in the VBA Editor like this: ?wdReplaceAll then press Enter.
objSelection.Find.Execute
should be
objSelection.Find.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
(assuming you want to replace all occurrences
This code running inside a word module will replace all "cat" with "dog"
Sub test()
Dim objdoc As Document
Dim objSelection As Range
Set objdoc = ActiveDocument
Set objSelection = Selection.Range
With objSelection.Find
.Forward = True
.MatchWholeWord = False
.Text = "Cat"
.Replacement.Text = "Dog"
.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
If .Found Then
Debug.Print "Found"
End If
End With
End Sub
However you're running in vbscript using late binding, so possibly there's a type issue - you're selection object may not be a range but a variant?
Im currently facing problem where the Component GUID of msi are in lower case. Need to convert all the Component GUID to upper case, hence wrote a small script as below:
VBS:
msi_fullpath = <Path of msi>
Dim strLine
strLine = "UPDATE Component SET ComponentId = UPPER(ComponentId)"
Set WI = CreateObject("WindowsInstaller.Installer")
Set DB = WI.OpenDatabase(msi_fullpath, 1)
' Update
Set view = DB.OpenView(strLine)
view.Execute
DB.Commit
View.Close
Set view = Nothing
Set DB = Nothing
Set WI = Nothing
However the above does not work. Can someone please help?
I have a subprocedure that should process word and excel files. In order to make it more generic, I wanted to pass some elements as parameters, instead of writing the same stuff with minor differences several times.
The procedure accepts the extensions of the files, which works just fine. However, I also need to use either appWord.Documents.Open or appExcel.Workbooks.Open to open a file. How can I store it and call it as a parameter of the procedure?
ResaveFiles "appExcel.Workbooks", "docx", 12, 0
ResaveFiles "appExcel.Workbooks", "doc", 0, 12
ResaveFiles "appWord.Documents", "xlsx", 56, 51
ResaveFiles "appWord.Documents", "xls", 51, 56
Sub ResaveFiles(appType, srcExtName, srcExtNum, tmpExtNum)
If lcase(fso.GetExtensionName(objFileOrig)) = srcExtName then
<<StartWord>>
Set objOpenFile = (appType.Open(objFileOrig.path))
...
So, what I am ultimately aiming at is to have one procedure instead of four, because the only difference between them is the file formats and the application that is being invoked.
I have no problems with the file formats, however, I cannot pass the parameter "appWord.Documents" into Set objOpenFile = (appType.Open(objFileOrig.path)) statement. The version presented above doesn't seem to work because the the parameter is presented as a string.
Is there a way to optimize this?
If you have already created the objects appExcel and appWord earlier, then remove the "" marks around them. For example, below opens the blank file for each Word and Excel:
Dim oExcel, oWord
set oExcel = CreateObject("Excel.Application")
set oWord = CreateObject("Word.Application")
TestOpen oExcel.Workbooks, "C:\Test\blank.xlsx"
TestOpen oWord.Documents, "C:\Test\blank.docx"
Sub TestOpen(oApp, sFile)
Dim oFile
oApp.Parent.Visible = True
Set oFile = oApp.Open(sFile)
Wscript.Echo "File opened: " & oFile.Name
Set oFile = Nothing
End Sub
Set oExcel = Nothing
Set oWord = Nothing
Example output:
I am working on creating a signature in outlook using VBS to push to our users. The signature has tables in it so i can have a logo / user information side by side vs. the standard text on top of a logo. (Original table code found here: http://www.vbforums.com/showthread.php?526706-resolved-question-with-tables-in-vbscript-for-AD-signature)
Below is a snipit of the code that writes to the doc file. The code sucessfully creates two coluns and puts whatever information i want into them. Is there a way to add text to the top of the doc file before it starts creating / editing the tables?
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
Set objRange = objDoc.Range()
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
'I want to add text here above the two tables below. Not sure how to do it.
'Create Tables
objDoc.Tables.Add objRange, 1, 2
Set objTable = objDoc.Tables(1)
'** Logo table **
objTable.Cell(1, 1).select
'Put Logo information here
'** User table **
objTable.Cell(1, 2).select
'Put User information here
objSelection.EndKey 6 'Command to end the above tables
I stumbled upon the issue by working with the script found here: http://blogs.technet.com/b/heyscriptingguy/archive/2006/06/09/how-can-i-add-multiple-tables-to-a-word-document.aspx
'Create Tables
Set objRange = objSelection.Range 'Adding this line fixed the problem
objDoc.Tables.Add objRange, 1, 2
Set objTable = objDoc.Tables(1)
I'm gettinga n error message in line 8 when I try to call out the script to stop when it finds teh attribute in the Web page: field in AD.
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)
strwWWHomePage = objItem.Get("wWWHomePage")
If wWWHomePage 6 Then
wscript.quit
Else
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True
ppt.Presentations.Open "\\abngan01\tracking\ppt.pptx"
End If
You have:
If wWWHomePage 6 Then
I'm assuming you want it to say:
If wWWHomePage = 6 Then
Since the missing "=" will cause an error, but since that code really doesn't do anything anyway, other than just abort the script, you could simplify your code by only taking action if that value is not set, for example:
If objItem.Get("wWWHomePage") <> 6 Then
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True
ppt.Presentations.Open "\\abngan01\tracking\ppt.pptx"
End If
I'm also assuming "6" is some sort of flag you've set yourself, you might want to use something a little more descriptive like "PPTSTATUS006", or something along those lines.