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:
Related
I'm fairly new to scripting and am in need of some help. I have come across a unique situation for a Non-Profit client of ours that requires us to compare two or more files in a specific folder and move the file with the lowest numerical value in the filename.
This organization runs a non-profit radio station which has content submitted from hundreds of volunteers that name their files (when they record more than one) with various numbers at the end that either represent the date or the order in which the files are to be aired.
Essentially I am looking to create a vbscript (because I think it can be done this way) that will run with windows task scheduler 30 minutes prior to the first air date of the content and move the file with the lowest value (if more than one file exists) to a folder where it will be automatically processed by the radio automation software.
Examples of files in a folder might look something like these:
Folder1: (in this instance, "news.mp3" is the lowest value)
news.mp3
news1.mp3
news2.mp3
Folder2:
entertainment24.mp3
entertainment26.mp3
Folder3:
localnews081420.mp3
localnews081520.mp3
Honestly, on this one, I'm not even sure where to start. I've found several scripts that can look at file date or a specific numerical or date format in the filename, but none that can parse numbers from a filename and move/copy a file based on the numerical value. I'm hoping there is someone out there smarter than me that can point me in the right direction. Thanks for looking at my problem!
One script I've been playing with (from the scripting guy) looks at specific years in a filename:
strComputer = “.”
Set objWMIService = GetObject(“winmgmts:\\” & strComputer & “\root\cimv2”)
Set colFiles = objWMIService.ExecQuery _
(“ASSOCIATORS OF {Win32_Directory.Name=’C:\Test’} Where ” _
& “ResultClass = CIM_DataFile”)
Set objRegEx = CreateObject(“VBScript.RegExp”)
For Each objFile in colFiles
objRegEx.Global = True
objRegEx.Pattern = “\d{4}”
strSearchString = objFile.FileName
Set colMatches = objRegEx.Execute(strSearchString)
strYear = colMatches(0).Value
strNewFile = “C:\Test\” & strYear & “\” & objFile.FileName & _
“.” & objFile.Extension
objFile.Copy(strNewFile)
objFile.Delete
Next
...but I can't seem to make the leap to regular numbers and then take a lowest value...
You can use FileSystemObject to Work with Drives, Folders and Files.
Also i used GETNUM function to get number.
Try my way :
sFolder = "C:\Test\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile in oFSO.GetFolder(sFolder).Files
Number=GETNUM(objFile.Name)
strNewFile = sFolder & Number & "\" & objFile.Name
If NOT (oFSO.FolderExists(sFolder & Number)) Then
oFSO.CreateFolder(sFolder & Number)
End If
oFSO.MoveFile objFile, strNewFile
Next
Function GETNUM(Str)
For i=1 To Len(Str)
if IsNumeric(Mid(Str,i,1)) Then
Num=Num&Mid(Str,i,1)
End if
Next
GETNUM=Num
End Function
For understanding the used code and how they work, open these sites and read all pages very carefully.
MoveFile method
Vbs Script to check if a folder exist
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?
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!
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
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.