Office Scripts

PrintReport.vbs demonstrates another use of scripts; it prints a report from Northwind.accdb, without the need to open the database. This could be handy if you need to print out labels on a regular basis. The code for this script is listed as follows:

Dim appAccess Dim strDBName

Set appAccess = _

WScript.CreateObject("Access.Application") Set fso = _

WScript.CreateObject("Scripting.FileSystemObject") Modify the hard-coded file path as needed for your system:

strDBName = "D:\Documents\Northwind.accdb"

On Error Resume Next appAccess.OpenCurrentDatabase strDBName

Set fil = fso.GetFile(strDBName) If fil Is Nothing Then strPrompt = "Can't find " & strDBName &

"; canceling" MsgBox strPrompt, vbCritical + vbOKOnly Quit

Else

'Print report appAccess.DoCmd.OpenReport "rptCustomerLabels" End If

Set appAccess = Nothing

F If the MSE is already open, you can open a new script for editing by dragging the script file from an Explorer pane into the MSE window.

Northwind.accdb has a form for selecting an invoice to print by order number. But you might want to be able to quickly print an invoice without opening the database; the PrintInvoice.vbs script listed next does just this:

Dim appAccess Dim strDBName Dim lnglnvoiceNo Dim strTitle Dim strPrompt

Set appAccess = _

WScript.CreateObject("Access.Application") Set fso = _

WScript.CreateObject("Scripting.FileSystemObject") strDBName = "D:\Documents\Northwind.accdb"

On Error Resume Next appAccess.OpenCurrentDatabase strDBName

Set fil = fso.GetFile(strDBName) If fil Is Nothing Then strPrompt = "Can't find " & strDBName & _

"; canceling" MsgBox strPrompt, vbCritical + vbOKOnly Quit Else strTitle = "Select invoice"

strPrompt = "Select an invoice to print (10248 - 11077)" lnglnvoiceNo = CLng(InputBox(strPrompt, strTitle)) 'MsgBox "Invoice No.: " & lnglnvoiceNo

Run a lengthy SQL statement to create a table for use as a report record source:

strSQL = "SELECT DISTINCT qrylnvoices.OrderlD, " _ & "qryInvoices.ShipName, qryInvoices.ShipAddress, & "qryInvoices.ShipCityStateZip, " _

& "qrylnvoices.ShipCountry, " _

& "qrylnvoices.CustomerlD, qrylnvoices.CompanyName, " _ & "qrylnvoices.BillToAddress, " _ & "qrylnvoices.BillToCityStateZip, " _ & "qrylnvoices.BillToCountry, " _ & "qrylnvoices.Salesperson, " _

& "qrylnvoices.OrderDate, qrylnvoices.RequiredDate, " _ & "qrylnvoices.ShippedDate, qrylnvoices.Shipper, " _ & "qtotlnvoiceDetails.SumOfExtendedPrice " _ & "AS Subtotal, " _

& "qrylnvoices.Freight, [SumOfExtendedPrice] " _ & "+ [Freight] " _ & "AS Total INTO tmaklnvoice " _ & "FROM qrylnvoices " _ & "INNER JOIN qtotlnvoiceDetails " _ & "ON qrylnvoices.OrderlD = " _ & "qtotlnvoiceDetails.OrderlD " _ & "WHERE qrylnvoices.OrderlD = " & lnglnvoiceNo appAccess.DoCmd.SetWarnings False appAccess.DoCmd.RunSQL strSQL

appAccess.DoCmd.OpenReport "rptSinglelnvoice" End If

Set appAccess = Nothing

When this script is run, an input box pops up where you can enter an invoice number, as shown in Figure 17.16.

FIGURE 17.16

An input box popped up from a WSH script.

_I Select invoice i&S

Select an invoice to print (10248 -11077]

1 « 1 Cancel |

110250

After you enter the invoice number and click OK, a SQL statement is run to create a make-table query that is part of the record source of rptSinglelnvoice, and that report is printed. The report is shown in Figure 17.17.

FIGURE 17.17

An Access report printed from a WSH script.

FIGURE 17.17

An Access report printed from a WSH script.

As a quick alternative to opening Word or Excel and selecting the correct template, you can also use a WSH script to create a new Word document or Excel worksheet based on a template. This technique can be useful when users have problems selecting the correct template to use when creating a new Word document or Excel worksheet. The New Document from Template.vbs script listed next opens a new Word document based on a Word 97-2003 template located in the main User Templates folder:

Dim appWord Dim strTemplatePath Dim strUserTemplatePath Dim strTemplate Dim docs strTemplate = "Test Letter.dot"

Set appWord = WScript.CreateObject("Word.Application")

Get the User Templates path from the Word Options dialog, using the DefaultFilePath property with the argument:

strUserTemplatePath = appWord.Options.DefaultFilePath(2) _ & "\"

'MsgBox "User templates path: " & strUserTemplatePath If strUserTemplatePath <> "\" Then Set fso = _

WScript.CreateObject("Scripting.FileSystemObject") strTemplatePath = strUserTemplatePath & strTemplate MsgBox "Source template and path: " & strTemplatePath

On Error Resume Next

Set fil = fso.GetFile(strTemplatePath) If fil Is Nothing Then strPrompt = "Can't find " & strTemplate & _

" in " & strTemplatePath & " folder; canceling" MsgBox strPrompt, vbCritical + vbOKOnly Quit Else

Set appWord = WScript.CreateObject("Word.Application")

appWord.Visible = true

Set docs = appWord.Documents docs.Add(strTemplate)

End If

Else strPrompt = _

"User template path not selected; canceling" MsgBox strPrompt, vbCritical + vbOKOnly End If

The New Worksheet from Template.vbs script listed next opens a new Excel worksheet based on an Excel 2007 template located in the main User Templates folder:

Dim appExcel

Dim strTemplatePath

Dim strTemplate

Dim bks

Dim wkb

Dim wks strTemplate = "Access Contacts.xltx"

Get the User Templates path from the Word Options dialog.

Set appWord = WScript.CreateObject("Word.Application")

strUserTemplatePath = appWord.Options.DefaultFilePath(2) _ &

WScript.CreateObject("Scripting.FileSystemObject") strTemplatePath = strUserTemplatePath & strTemplate MsgBox "Source template and path: " & strTemplatePath

On Error Resume Next

Set fil = fso.GetFile(strTemplatePath) If fil Is Nothing Then strPrompt = "Can't find " & strTemplate & _

" in " & strScriptPath & " folder; canceling" MsgBox strPrompt, vbCritical + vbOKOnly Quit Else

Set appExcel = WScript.CreateObject("Excel.Application") appExcel.Visible = True Set bks = appExcel.Workbooks Set wkb = bks.Add(strTemplatePath) Set wks = wkb.Sheets(i) wks.Activate End If

Miscellaneous Scripts

The next script is one I made to automate the process of deleting temporary files from Audible.com downloads. These files are sometimes not automatically deleted and have to be deleted manually, which is a nuisance; the Delete Audible Files.vbs script is listed as follows:

Dim fso Dim strPath Dim strFile Dim strFilePath Dim blnFound

Set fso = CreateObject("Scripting.FileSystemObject") blnFound = False strPath = "E:\Audible\Bin\" strFile = "Debug.log" strFilePath = strPath & strFile If fso.FileExists(strFilePath) Then fso.DeleteFile strFilePath blnFound = True End If strFile = "aadownload.log" strFilePath = strPath & strFile If fso.FileExists(strFilePath) Then fso.DeleteFile strFilePath blnFound = True End If strFile = "aaschedule.log" strFilePath = strPath & strFile If fso.FileExists(strFilePath) Then fso.DeleteFile strFilePath blnFound = True End If strFile = "aasubsschedule.log" strFilePath = strPath & strFile If fso.FileExists(strFilePath) Then fso.DeleteFile strFilePath blnFound = True End If

If blnFound = True Then

MsgBox "Deleted Audible temp files" Else

MsgBox "No Audible temp files found" End If

The script first sets a blnFound variable to False (it would be a Boolean variable, if variables could be declared with data types in VBS). Then the script uses the FileExists method of the FileSystemObject to determine whether a file exists, and delete it if so, setting blnFound to True. At the end of the code, depending on whether the blnFound variable is True or False, a message box appears saying either "Deleted Audible temp files" or "No Audible temp files found."

You probably don't need the Delete Audible Files.vbs script, but you may find the Delete Temp Files.vbs script useful. This script uses the GetSpecialFolder method of the FileSystemObject, with the 2 argument, to set a fldTemp variable to the Temp file folder, and puts up a message box that asks if you want to delete all files in it; if you click the Yes button, the script attempts to delete all the files in that folder (the On Error Resume Next statement goes to the next file if a file can't be deleted, because it is in use):

Dim fso Dim fldTemp Dim fil Dim n

Dim intResult Dim strPrompt

Set fso = CreateObject("Scripting.FileSystemObject") Set fldTemp = fso.GetSpecialFolder(2) strPrompt = "Delete all files in " & fldTemp & "?" intResult = MsgBox (strPrompt, vbQuestion + vbYesNo) If intResult = 6 Then

On Error Resume Next n = 0

For Each fil in fld.Files fil.Delete n = n + 1 Next

MsgBox "Approximately " & n _

& " temp files deleted from " & fldTemp

End If

The next script, Rename Files.vbs, renames figure files in a folder in a specific manner; the strNewFileName = Mid(fil.Name, 9) line of the script can be modified to rename files as needed:

Dim fld Dim lngCount Dim fso

Dim strScriptPath

Dim strScriptName

Dim strScriptNameAndPath

Dim fil

Dim strPrompt strScriptName = WScript.ScriptName

Get the path of the current script, using the ScriptFullName property:

strScriptNameAndPath = WScript.ScriptFullName strScriptPath = Mid(strScriptNameAndPath, 1, _

Len(strScriptNameAndPath) - Len(strScriptName))

On Error Resume Next lngCount = 0

Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.GetFolder(strScriptPath)

For Each fil In fld.Files

Check the first character and extension (modify as needed for your requirements):

Modify the following line as needed for your requirements:

strNewFileName = Mid(fil.Name, 9) fil.Name = strNewFileName lngCount = lngCount + 1 End If Next strTitle = "Files renamed" strPrompt = lngCount & " files in " _

& strScriptPath & " renamed" MsgBox strPrompt, vblnformation, strTitle

0 0

Post a comment