I get an error that on line 6, the one with lnk.TargetPath, that the argument is invalid. I am hoping to make a link to this program under the start menu on the desktop. Anybody know why it is doing this?
Set objShell = WScript.CreateObject("WScript.Shell")
Set lnk = objShell.CreateShortcut("C:\Users\%USERDATA%\Desktop\Shutdown.LNK")
Dim strUserProfile
strUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
lnk.TargetPath = "C:\Users\" & strUserProfile & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\shutdown.bat"
lnk.Arguments = ""
lnk.Description = "Shutdown"
'lnk.HotKey = "ALT+CTRL+F"
lnk.IconLocation = "C:\Users\" & strUserProfile & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\shutdown.bat, 2"
lnk.WindowStyle = "1"
lnk.WorkingDirectory = "C:\Users\" & strUserProfile &"\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
lnk.Save
Set lnk = Nothing
I think it's because strUserProfiles holds the full path of user directory. Try this slightly modified code:
Set objShell = WScript.CreateObject("WScript.Shell")
Dim strUserProfile
strUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
Set lnk = objShell.CreateShortcut(strUserProfile & "\Desktop\Shutdown.LNK")
lnk.TargetPath = strUserProfile & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\shutdown.bat"
lnk.Arguments = ""
lnk.Description = "Shutdown"
'lnk.HotKey = "ALT+CTRL+F"
lnk.IconLocation = strUserProfile & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\shutdown.bat, 2"
lnk.WindowStyle = "1"
lnk.WorkingDirectory = strUserProfile &"\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
lnk.Save
Set lnk = Nothing
Related
I am receiving the object required error on the following line, although fl4 is a defined variant/object/file:
oFold.CopyHere (fl4)
Any thoughts would be appreciated.
Below is an applicable excerpt of code. I have excluded the recursive loop and directory sub folder iteration:
srcpth = rs1.Fields("Src_File_Path").Value
destpth = rs1.Fields("Zip_File_Path").Value
var = 0
Set FS2 = New FileSystemObject
Set FS2 = CreateObject("Scripting.FileSystemObject")
Set fl1 = FS2.GetFolder(srcpth)
For Each fl2 In FS2.GetFolder(srcpth).SubFolders
var = 2
ZipFile = Application.CurrentProject.Path & "\tmp\" & fl2.Name & ".zip"
Set FS3 = CreateObject("Scripting.FileSystemObject")
FS3.CreateTextFile(ZipFile, True).Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
Set FS3 = Nothing
Set FS4 = New FileSystemObject
Set FS4 = CreateObject("Scripting.FileSystemObject")
Set fl3 = FS4.GetFolder(fl2)
For Each fl4 In FS4.GetFolder(fl2).Files
var = 2
GoTo Zipxchg
zipxchg_2:
Next
Next
Set FS1 = Nothing
Set oFld = Nothing
Set oApp = Nothing
Set oShl = Nothing
Exit Sub
Zipxchg:
If var = 2 Then
ZipFile = Application.CurrentProject.Path & "\tmp\" & fl2.Name & ".zip"
Set oApp = CreateObject("Shell.Application")
Set oFld = oApp.NameSpace(CVar(ZipFile))
Set FilestoZip = objShell.File(fl4)
i = oFld.Items.Count
oFold.CopyHere (fl4)
Set oShl = CreateObject("WScript.Shell")
GoTo zipxchg_2
End Sub
remove the brackets .... use oFold.CopyHere fl4 .... brackets cause a value to be returned, but there is no variable (object) to receive it
Trying to read a single value in a text file and use that value to match a position on a csv in order to generate a unique shortcut with arguments. I'm having trouble finding the error in my VBS logic in the script below:
dim objFS,objFileToRead,objTextFile, strSiteCode, strServerFQDN, strPort, mySiteCode
dim arrStr
strComputer = "."
Set objFS = CreateObject("Scripting.FileSystemObject")
set objTextFile = objFS.OpenTextFile("Servers.csv")
Set objFileToRead = objFS.OpenTextFile("code.txt",1)
Set mySiteCode = objFileToRead.ReadAll()
Set WSHShell = CreateObject("WScript.Shell")
Do while NOT objTextFile.AtEndOfStream
arrStr = Split(objTextFile.ReadLine,",")
strSiteCode = arrStr(0)
strServerFQDN = arrStr(1)
strPort = arrStr(2)
if mySiteCode = strSiteCode then
'wscript.echo "Site Code: " & strSiteCode & " - Server FQDN: " & strServerFQDN & " - Port #: " & strPort
fullname = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Generic\Generic.lnk"
TargetPath = "%SystemRoot%\Generic\Generic.exe"
Set shortcut = WSHShell.CreateShortcut(fullname)
shortTarget = shortcut.TargetPath
shortcut.Arguments = "s=" & strServerFQDN & " p=" & strPort
shortcut.save
fullname = "C:\Users\Public\Desktop\Generic.lnk"
TargetPath = "%SystemRoot%\Generic\Generic.exe"
Set shortcut = WSHShell.CreateShortcut(fullname)
shortTarget = shortcut.TargetPath
shortcut.Arguments = "s=" & strServerFQDN & " p=" & strPort
shortcut.save
end if
Loop
I'm wondering if I need to load both the csv and txt file in to an array in order to create the shortcut with the correct information.
Resources:
servers.csv (file contains info in format below)
Site1,10.0.0.1,12345
Site2,10.0.0.2,23456
...
code.txt (file contains only one line which is site identifier)
Site1
If you'd execute the script from an open cmd window with
cscript YourScriptName.vbs
you will see the error message. I think you should change the lines
shortTarget = shortcut.TargetPath
to
shortcut.Target = TargetPath
or better directly to
shortcut.Target = "%SystemRoot%\Generic\Generic.exe"
As stated in a reply to LotPings (thanks for your feedback!) the issue was that the readall command was picking up the contents of the text file to include the CRLF at the end of the Site1 value. It was not obvious that these characters were present until opening the txt file in an editor that would display all characters.
Corrected and functional code is:
dim objFS,objFileToRead,objTextFile, strSiteCode, strServerFQDN, strPort, mySiteCode
dim arrStr
strComputer = "."
Set objFS = CreateObject("Scripting.FileSystemObject")
set objTextFile = objFS.OpenTextFile("Servers.csv")
Set objFileToRead = objFS.OpenTextFile("code.txt",1)
mySiteCode = objFileToRead.ReadLine()
Set WSHShell = CreateObject("WScript.Shell")
Do while NOT objTextFile.AtEndOfStream
arrStr = Split(objTextFile.ReadLine,",")
strSiteCode = arrStr(0)
strServerFQDN = arrStr(1)
strPort = arrStr(2)
if trim(mySiteCode) = trim(strSiteCode) then
'Start Menu Icon Creation Here
fullname = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Generic\Generic.lnk"
Set shortcut = WSHShell.CreateShortcut(fullname)
shortcut.TargetPath = "%SystemRoot%\Generic\Generic.exe"
shortcut.Arguments = "s=" & strServerFQDN & " p=" & strPort
shortcut.WorkingDirectory = "%SystemRoot%\Generic"
shortcut.save
'Desktop Icon Creation Here
fullname = "C:\Users\Public\Desktop\Generic.lnk"
Set shortcut = WSHShell.CreateShortcut(fullname)
shortcut.TargetPath = "%SystemRoot%\Generic\Generic.exe"
shortcut.Arguments = "s=" & strServerFQDN & " p=" & strPort
shortcut.WorkingDirectory = "%SystemRoot%\Generic"
shortcut.save
Exit Do
end if
Loop
I'm writing a VBScript to send email notification when a file arrives in Test folder. I want to attach that file to my email. The file name is not constant. Each time a file arrives with different name.
Below is my code:
Const PATH = "F:\Test"
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder: Set folder = fso.GetFolder(PATH)
If folder.Files.Count <> 0 Then
strSMTPFrom = "errorfile#test.com"
strSMTPTo = "test#test.com"
strSMTPRelay = "127.0.0.1"
strTextBody = "The attached file arrived in Test folder"
strSubject = "File arrived in Test folder"
strAttachment =
Set oMessage = CreateObject("CDO.Message")
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
oMessage.Configuration.Fields.Update
oMessage.Subject = strSubject
oMessage.From = strSMTPFrom
oMessage.To = strSMTPTo
oMessage.TextBody = strTextBody
oMessage.AddAttachment strAttachment
oMessage.Send
End If
I'd say what you actually want is a filesystem monitor. Something like this:
Sub SendNotification(filename)
'your mail sending code goes here
End Sub
Function CreateMonitor(path)
Set wmi = GetObject("winmgmts://./root/cimv2")
Set fso = CreateObject("Scripting.FileSystemObject")
path = Split(fso.GetAbsolutePathName(path), ":")
drv = path(0) & ":"
dir = Replace(path(1), "\", "\\")
If Right(dir, 2) <> "\\" Then dir = dir & "\\"
query = "SELECT * FROM __InstanceOperationEvent" & _
" WITHIN 1" _
" WHERE Targetinstance ISA 'CIM_DataFile'" & _
" AND TargetInstance.Drive=""" & drv & """" & _
" AND TargetInstance.Path=""" & dir & """"
Set CreateMonitor = wmi.ExecNotificationQuery(query)
End Function
Set monitor = CreateMonitor("F:\Test")
Do
Set evt = monitor.NextEvent()
If evt.Path_.Class = "__InstanceCreationEvent" Then
SendNotification evt.TargetInstance.Name
End If
Loop
The Name property of the TargetInstance object contains the full path to the new file. Put your mail sending code into the SendNotification function and have it attach filename to the mail.
To find the newest file in a folder, use this code:
Const PATH = "F:\Test"
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim myFolder: set myFolder = fso.getFolder(PATH)
dim myFile
dim recentFile
For Each myFile in myFolder.Files
If (isempty(recentFile)) Then
Set recentFile = myFile
ElseIf (myFile.DateLastModified > recentFile.DateLastModified) Then
Set recentFile = myFile
End If
Next
Then just use its path to attach the file.
strAttachment = recentFile.path
I am trying to check to see if a network location shortcut is in my Network Shortcut if it exist delete it and make another one called homedrive. How ever it makes the homedrive but doesnt delete the old one. the old one is registered by username hense why i used %username%. i just need help with the deleting
Thank You in Advance
Const NETHOOD = &H13&
Set objWSHShell = CreateObject("Wscript.Shell")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(NETHOOD)
Set objFolderItem = objFolder.Self
strNetHood = objFolderItem.Path
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Networkpath = Shell.SpecialFolders("NETHOOD")
shortcut = Networkpath & "\%username%.lnk"
If FSO.FileExists(shortcut) Then
FSO.DeleteFile shortcut
End If
strShortcutName = "HomeDrive"
strShortcutPath = "\\homer-2\IT$\%username%"
Set objShortcut = objWSHShell.CreateShortcut _
(strNetHood & "\" & strShortcutName & ".lnk")
objShortcut.TargetPath = strShortcutPath
objShortcut.Save
This
>> Set Shell = CreateObject("WScript.Shell")
>> Set FSO = CreateObject("Scripting.FileSystemObject")
>> sFSpec = FSO.BuildPath("%HOME%", "tmp.txt")
>> WScript.Echo CStr(FSO.FileExists(sFSpec)), sFSpec
>> sFSpec = Shell.ExpandEnvironmentStrings(sFSpec)
>> WScript.Echo CStr(FSO.FileExists(sFSpec)), sFSpec
>>
False %HOME%\tmp.txt
True C:\Documents and Settings\eh\tmp.txt
>>
proves that the FSO does not expand environment variables automagically. So
shortcut = Networkpath & "\%username%.lnk"
If FSO.FileExists(shortcut) Then
will never be true. Use Shell.ExpandEnvironmentStrings().
I'm trying to list all the calendar names in Outlook (my own and shared calendars).
dim oApp
dim oNameSpace
dim oFolder
dim fChild
dim fParent
dim sNames
fChild = Folder
fParent = Folder
sNames = ""
set oApp = CreateObject("Outlook.Application")
set oNameSpace = oApp.GetNamespace("MAPI")
for each fParent in oNameSpace.Folders
for each fChild in fParent.Folders
if fChild.DefaultItemType = 9 then
sNames = sNames & fParent.Name & " -- " & fChild.Name & vbCrLf
end If
next
next
MsgBox(sNames)
Am I on the right track?
Tou can use the NavigationModule object to iterate through all the groups of folders. Typically you could use objNavMod.NavigationGroups.GetDefaultNavigationGroup(olPeopleFoldersGroup), but if the user has added groups of calendars manually then this won't get you all the calendars. Also it's possible that permissions prevent accessing the folder programmatically; the code below allows for this.
const olFolderCalendar = 9
const olModuleCalendar = 1
Dim objOL
Dim objNS
Dim objExpCal
Dim objNavMod
Dim objNavGroup
Dim objNavFolder
Dim objFolder
Dim colExpl
dim s
s = ""
set oApp = CreateObject("Outlook.Application")
Set objNS = oApp.Session
Set colExpl = oApp.Explorers
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
For Each objNavGroup In objNavMod.NavigationGroups
For Each objNavFolder In objNavGroup.NavigationFolders
On Error Resume Next
Set objFolder = objNavFolder.Folder
If Err = 0 Then
s = s & objNavGroup.Name & " -- " & left(objFolder.FolderPath,30) & vbcrlf
Else
s = s & objNavGroup.Name & " -- " & objNavFolder.DisplayName & " [no permission]" & vbcrlf
End If
On Error GoTo 0
Next
Next
Set oApp = Nothing
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing
msgbox s
In VBA:
Sub IterateAllCalendars()
Dim s As String
Dim objOL As Outlook.Application
Dim objNS As Outlook.namespace
Dim objExpCal As Outlook.Explorer
Dim objNavMod As Outlook.CalendarModule
Dim objNavGroup As Outlook.NavigationGroup
Dim objNavFolder As Outlook.NavigationFolder
Dim objFolder As Outlook.Folder
Dim colExpl As Outlook.Explorers
s = ""
Set objOL = Application
Set objNS = objOL.Session
Set colExpl = objOL.Explorers
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
For Each objNavGroup In objNavMod.NavigationGroups
For Each objNavFolder In objNavGroup.NavigationFolders
On Error Resume Next
Set objFolder = objNavFolder.Folder
If Err = 0 Then
s = s & objNavGroup.Name & " -- " & Left(objFolder.FolderPath, 30) & vbCrLf
Else
s = s & objNavGroup.Name & " -- " & objNavFolder.DisplayName & " [no permission]" & vbCrLf
End If
On Error GoTo 0
Next
Next
Set objOL = Nothing
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing
MsgBox s
End Sub
#Geoff: Because this was the only slim, structured and working code I found - and I searched quite a while - I add my translation to pure WSH JScript.
var olAppointmentItem = 1;
var olFolderCalendar = 9;
var olFolderNotes = 12;
var olModuleCalendar = 1;
var olMyFoldersGroup = 1;
var oOtlk = new ActiveXObject('Outlook.Application' );
var oMAPI = oOtlk.getNameSpace("MAPI");
var oFldCldr = oMAPI.getDefaultFolder(olFolderCalendar);
var oExpl = oFldCldr.GetExplorer;
var oNavMod = oExpl.NavigationPane.Modules.GetNavigationModule(olModuleCalendar);
var msg = "";
var eGrps = new Enumerator(oNavMod.NavigationGroups);
for (; !eGrps.atEnd(); eGrps.moveNext()) {
var oGrp = eGrps.item();
msg += oGrp.Name + "\n";
var eFlds = new Enumerator(oGrp.NavigationFolders);
for (; !eFlds.atEnd(); eFlds.moveNext()) {
var oFld = eFlds.item();
msg += "\t" + oFld.DisplayName + "\n";
}
}
WScript.echo(msg);