Add Text Above MSWord Table Using VBS - vbscript

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)

Related

vbscript to dynamically update the excel cell range,when source data is updated and refresh the pivot table simultaneously

I have an excel workbook consisting of a source data and a pivot table.
the source data gets updated with new records daily along with some changes in the existing data.
I have written a vbscript in notepad and saved it with .vbs and I am calling it from Rstudio to perform the refresh pivot table action.
But,when I run this script in Rstuido :
pathofvbscript = ("D:\\Users\\703225799\\WIP\\R\\pivot\\r5.vbs")
shell(shQuote(normalizePath(pathofvbscript)),"cscript",flag =
"//nologo")
I am getting the following error :
D:\Users\703225799\WIP\R\pivot\r5.vbs(14, 1) Microsoft VBScript runtime
error: Object doesn't support this property or method: 'objWB.Range'
VBS code :
'------------------------------------------------------------------------
'Set Pivot Table & Source Worksheet
'------------------------------------------------------------------------
Set objExcel = CreateObject("Excel.Application")
Set objWB =
objExcel.Workbooks.Open("D:\Users\703225799\WIP\R\pivot\New
folder\Book1.xlsx")
Set Pivot_Sheet = objWB.Worksheets("pvt")
'-----------------------------------------------------------------------
'Enter in Pivot Table Name
'-----------------------------------------------------------------------
PivotName = "PivotTable1"
objWB.Activate
Set StartPoint = objWB.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
New_range = objWB.Name & "!" & DataRange.Address(xlR1C1)
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(xlDatabase,NewRange)
'----------------------------------------------------------------------
'Ensure Pivot Table is Refreshed
'----------------------------------------------------------------------
Pivot_Sheet.PivotTables(PivotName).RefreshTable
'Data_Sheet.Save
'MsgBox "Your Pivot Table is now saved."
'Data_Sheet.Close
'MsgBox "Your Pivot Table is now closed."
'objExcel.Quit
'MsgBox "objExcel quit."
'----------------------------------------------------------------------
'Complete Message
'----------------------------------------------------------------------
Pivot_Sheet.Activate
MsgBox "Your Pivot Table is now updated."
objWB.Save
objWB.Close
set objExcel = Nothing
set Data_Sheet = Nothing
Set Pivot_Sheet = Nothing
Please help with the error.
Thanks,
Sayan
Please try using Pivot_Sheet.Range("A1") instead of objWB.Range("A1") as the worksheet object is Pivot_sheet

How can I add a line between output text?

The next title will replace the previous title on the same line. As a result, only the last one of the titles will finally remain in the text file.
My following VBScript will find a number of update titles (="Title" in the script). Each "Title" will be shown in the output file "c:\Testing\testing.txt". One title will be shown on the first line at a time. The command "Next" will bring up the next title, which will be shown on the same line when the previous title disappears. Simply put, the next title will replace the previous title on the first line. As a result, only the last one of the titles will finally remain in the file. Is it possible to add an empty line between two titles, so that all titles will be shown in the file?
Set Job = CreateObject("Microsoft.Update.Session")
Set Tool = Job.CreateupdateSearcher()
Set Result = Tool.Search("IsInstalled=0 and IsHidden=0")
For Number = 0 To Result.Updates.Count-1
Set Title = Result.Updates.Item(Number)
Set objFSO = CreateObject("Scripting.FileSystemObject")
outFile = "c:\Testing\testing.txt"
Set objFile = objFSO.CreateTextFile(outFile, True)
objFile.Write Title & vbCrLf
objFile.Close
Next
I want the titles shown on different lines rather than on the same line.
I just found that both OpenTextFile and 8, True are not necessary in the following script, which works at my end.
Set Job = CreateObject("Microsoft.Update.Session")
Set Tool = Job.CreateupdateSearcher()
Set Result = Tool.Search("IsInstalled=0 and IsHidden=0")
Set X = CreateObject("Scripting.FileSystemObject")
Set Z = X.CreateTextFile("Updates_found.txt")
For Number = 0 To Result.Updates.Count-1
Set Title = Result.Updates.Item(Number)
Z.Writeline Title
Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("c:\Testing\testing.txt", True) 'True = overwrite existing file
objFile.Close
Set objFile = objFSO.OpenTextFile("c:\Testing\testing.txt", 8) '8 = For Appending
objFile.WriteLine ("Title")
objFile.WriteLine ("Title2")
objFile.Close
Hope this helps!

VBS to address file on desktop

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

Creating a table in "MSWord" document out of a text in a .txt file

In the following file "E:\my_folder\my_future_table.txt" I have this text:
# animal country
1 rabbit Germany
2 wolf France
3 koala USA
(please note that all the words in each line of that text are separated by tabs)
What VBS script do I need to use in order to create a "Word" file (.doc) with a table created on the basis of that text? (In this example, the table should have 3 columns and 4 rows)
Something like this with a healthy degree of credit to the Scripting Guy
The vbs reads the test file (pls change your path), and then splits it by line break into an array ArrVar
Each line in this array is split further by VbTab into a second array, ArrVar2
The vbs creates a word table equal in size to the length of ArrVar and width of ArrVar2
Each item is written to the table cell by cell, row by row
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objRange = objDoc.Range()
strFilePath = "c:\temp\my_future_table.txt"
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.opentextfile(strFilePath)
strAll = objTF.readall
arrVar = Split(strAll, vbNewLine)
numcols = UBound(Split(arrVar(0), vbTab)) + 1
objDoc.Tables.Add objRange, UBound(arrVar) - LBound(arrVar) + 1, numcols
Set objTable = objDoc.Tables(1)
For lngrow = LBound(arrVar) To UBound(arrVar)
arrVar2 = Split(arrVar(lngrow), vbTab)
For lngcol = LBound(arrVar2) To UBound(arrVar2)
objTable.Cell(lngrow + 1, lngcol + 1).Range.Text = arrVar2(lngcol)
Next
Next
objTF.Close
set objFSO = Nothing
objTable.AutoFormat (9)
objWord.Visible = True

Call out to script to stop with attribute in wWWHomePage

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.

Resources