I want to send a mail to my colleagues in an automated format. For this I have a code but the issue is I am unable to give line feed or hard enter in between the lines. Here is my code:
Dim s
Set s = CreateObject("WScript.Shell")
inputCont = Wscript.Arguments.Item(0)
inputCust = Wscript.Arguments.Item(1)
processCust = Wscript.Arguments.Item(2)
msgbody = "Hi All " & chr(13) & "fine"
s.run Chr(34) & "c:\Program Files\mozilla thunderbird\thunderbird.exe" & Chr(34) & " -compose mailto:aaa#gmail.com?subject=subject-crash" & inputCont & "&body=" & msgbody & ""
WScript.Sleep 10000
s.SendKeys "^{ENTER}"
WScript.Sleep 1000
Regards
B. Jithesh
Related
Here is my dilemma. I have a vb.net application for requesting time using an asset. The user submits a request (can contain required and optional users), then an approver has to approve it. When it is approved, I want to send a meeting request. I can't do it using outlook code since it won't let me change the organizer. If I try to send it using outlook.application > outlook.olitemtype.olappointmentitem or whatever it is, it will default the organizer to the person sending the meeting request, which in this case is the approver, which I don't want. So I think I am left with trying to send an ical. This is where I am having issues. I can't use smtpclient to create the email and send it using the proper content-type, etc. I have to send it using outlook. So I create an ics file and add it as an attachment. I am not sure the difference between METHOD:PUBLISH and METHOD:REQUEST. All the searches I've have done say I should use method:request, but when i open the ICS file, it doesn't give me the options to accept, etc. It doesn't add to my calendar. I want the ability to be able to update and cancel the meeting as well, which I think I know how to do with uid, sequence, etc. I've done searches and just can't get to where I need to be. It looks like the best option is to use smtpclient to create the mail message where you add the headers and ical stuff, but I can't do that, is there a way to it using outlook?
If someone can help point me in the right direction, I would greatly appreciate it.
Here is my current code:
Dim msg As MailMessage = New MailMessage
msg.From = New MailAddress(br.requesting_user_email)
msg.To.Add(New MailAddress(br.requesting_user_email))
msg.Subject = variables.UserInfo.last_name & ", " + variables.UserInfo.first_name & " has approved your request through the Bench Scheduler."
Dim bodytxt As String = "User: " & variables.UserInfo.last_name & ", " + variables.UserInfo.first_name & vbLf & "5+2: " + variables.UserInfo.username & vbLf & vbLf
bodytxt += "Has approved your bench request for " & br.program_name & " - " & br.project_name & "." & vbLf & vbLf
bodytxt += "Start: " & br.start_time & vbLf & "End: " & br.end_time & vbLf
bodytxt += "Bench: " & br.bench_name & vbLf & "Priority: " & br.priority & vbLf & "Purpose: " & br.objective & vbLf & vbLf
bodytxt += "Request Notes: " & br.notes & vbLf & vbLf
bodytxt += vbLf & vbLf & vbLf & "This email was automatically generated by Bench Scheduler. You may respond to this email."
msg.Body = bodytxt
Dim str As StringBuilder = New StringBuilder
str.AppendLine("BEGIN:VCALENDAR")
str.AppendLine("PRODID:-//Microsoft Corporation//Outlook 15.0 MIMEDIR//EN")
str.AppendLine("VERSION:2.0")
If cancel Then
str.AppendLine("METHOD:CANCEL")
Else
str.AppendLine("METHOD:REQUEST")
End If
str.AppendLine("BEGIN:VEVENT")
str.AppendLine("X-MS-OLK-FORCEINSPECTOROPEN:TRUE")
str.AppendLine("BEGIN:VTIMEZONE")
str.AppendLine("TZID:Eastern Standard Time")
str.AppendLine("BEGIN:STANDARD")
str.AppendLine("DTSTART:16011104T020000")
str.AppendLine("RRULE:FREQ=YEARLY;BYDAY=1SU;BYMONTH=11")
str.AppendLine("TZOFFSETFROM:-0400")
str.AppendLine("TZOFFSETTO:-0500")
str.AppendLine("END:STANDARD")
str.AppendLine("BEGIN:DAYLIGHT")
str.AppendLine("DTSTART:16010311T020000")
str.AppendLine("RRULE:FREQ=YEARLY;BYDAY=2SU;BYMONTH=3")
str.AppendLine("TZOFFSETFROM:-0500")
str.AppendLine("TZOFFSETTO:-0400")
str.AppendLine("END:DAYLIGHT")
str.AppendLine("END:VTIMEZONE")
Dim dt As New DataTable
Dim ta As New BSDataSetTableAdapters.getUserRequestTableAdapter
dt = ta.GetData(br.request_id, "T")
For Each row As DataRow In dt.Rows
If row("type") = "Required" Then
str.AppendLine(String.Format("ATTENDEE;CN='{0}';RSVP=TRUE:mailto:{1}", row("username"), row("email")))
ElseIf row("type") = "Optional" Then
str.AppendLine(String.Format("ATTENDEE;CN='{0}';ROLE=OPT-PARTICIPANT;RSVP=TRUE:mailto:{1}", row("username"), row("email")))
End If
Next
str.AppendLine("CLASS:PUBLIC")
str.AppendLine("CREATED:" & Format(Date.Now, "yyyyMMddTHHmmssZ"))
str.AppendLine(String.Format("DESCRIPTION:{0}", br.objective))
str.AppendLine("DTEND;TZID=" & """" & "Eastern Standard Time" & """" & ":" & Format(CDate(br.end_time), "yyyyMMddTHHmmss"))
str.AppendLine("DTSTAMP:" & Format(Date.Now, "yyyyMMddTHHmmssZ"))
str.AppendLine("DTSTART;TZID=" & """" & "Eastern Standard Time" & """" & ":" & Format(CDate(br.start_time), "yyyyMMddTHHmmss"))
str.AppendLine(String.Format("LOCATION:{0}", br.bench_name))
str.AppendLine(String.Format("ORGANIZER;CN='" & br.requesting_username & "':mailto:" & br.requesting_user_email))
str.AppendLine("PRIORITY:5")
str.AppendLine("SEQUENCE:0")
str.AppendLine(String.Format("SUMMARY;LANGUAGE=en-us:{0}", "Approved Bench Request (ID-" & br.request_id & "): " & br.program_name & "-" & br.project_name & "-" & br.activity))
str.AppendLine("TRANSP:OPAQUE")
str.AppendLine(String.Format("UID:{0}", br.uid))
str.AppendLine(String.Format("X-ALT-DESC;FMTTYPE=text/html:{0}", br.objective))
str.AppendLine("X-MICROSOFT-CDO-BUSYSTATUS:BUSY")
str.AppendLine("X-MICROSOFT-CDO-IMPORTANCE:1")
str.AppendLine("X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY")
str.AppendLine("X-MICROSOFT-DISALLOW-COUNTER:FALSE")
str.AppendLine("X-MS-OLK-AUTOFILLLOCATION:FALSE")
str.AppendLine("X-MS-OLK-CONFTYPE:0")
str.AppendLine("BEGIN:VALARM")
str.AppendLine("TRIGGER:-PT30M")
str.AppendLine("ACTION:DISPLAY")
str.AppendLine("DESCRIPTION:Reminder")
str.AppendLine("END:VALARM")
str.AppendLine("END:VEVENT")
str.AppendLine("END:VCALENDAR")
Dim smtpclient As SmtpClient = New SmtpClient
smtpclient.Host = "replaced for privacy"
smtpclient.Credentials = System.Net.CredentialCache.DefaultNetworkCredentials
Dim contype As System.Net.Mime.ContentType = New System.Net.Mime.ContentType("text/calendar")
contype.Parameters.Add("method", "REQUEST")
contype.Parameters.Add("name", "Meeting.ics")
Dim avcal As AlternateView = AlternateView.CreateAlternateViewFromString(str.ToString, contype)
msg.AlternateViews.Add(avcal)
smtpclient.Send(msg)
The problem of this script is that it shows an unknown error Message while running the script.
I called the function by echo method in my ftp which is "filezilla".
every thing is working fine as it logs into the server check for the path, open channel for data writing. Still dont know where is the problem
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalFile = Trim(sLocalFile)
'----------Path Checks---------
'Here we willcheck the path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = """" & sLocalFile & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'Check the local path and file to ensure
'that either the a file that exists was
'passed or a wildcard was passed.
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
"space." & vbCRLF
FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
'nothing to upload
FTPUpload = "Error: File Not Found."
Exit Function
End If
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
'Write the input file for the ftp command
'to a temporary file.
Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Set fFTPScript = Nothing
oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
" > " & sFTPResults, 0, TRUE
Wscript.Sleep 1000
'Check results of transfer.
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
If InStr(sResults, "226 Transfer complete.") > 0 Then
FTPUpload = True
ElseIf InStr(sResults, "File not found") > 0 Then
FTPUpload = "Error: File Not Found"
ElseIf InStr(sResults, "cannot log in.") > 0 Then
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
WScript.Echo "Process Completed (" & Now & ")"
End Function
I am [attempting to] learn how to write a script in Outlook that when a certain category is set on an email:
Append the Subject with " PROJ=5"
Append the Body with about 10 lines of text
Send email.
My goal is to mark an email with a category and forward the email to our ticketing system.
I'm not really having any luck with the samples I have found.
Samples (URL) I have tried (Copied code and updated relevant fields):
slipstick.com
social.technet.microsoft.com
Append the Subject with " PROJ=5"
MailItem.Subject Property Returns a String indicating Outlook item. Read/write.
Example
Item.Subject = "PROJ=5" & Item.Subject
Append the Body with about 10 lines of text
Example
Dim olBody As String
olBody = "<HTML><BODY><P>Append the Body with about 10 lines of text</P>" & vbNewLine & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P></HTML></BODY>" & vbNewLine
olForward.HTMLBody = olBody & vbCrLf & olForward.HTMLBody
Send / Forward Email
Example
'//
Set olForward = Item.Forward
'// add Recipent
olForward.Recipients.Add "email#domain.com"
'// Send or your use .Dispaly
olForward.Send
Run a Script Rule
To use Rule Wizard, your macro has to have the expected parameter:
Example
Public Sub ItemForward(Item As Outlook.MailItem)
End Sub
Helpful article in MSDN Outlook 2010 VBA
Complete Code Test on Outlook 2010 VBA
Please make sure your References are set to run action script (Tools > References)
Option Explicit
'// Run Action Script
Public Sub ItemForward(Item As Outlook.MailItem)
Dim olApp As Outlook.Application
Dim olForward As MailItem
Dim olBody As String
Set olApp = CreateObject("Outlook.Application")
'// Append the Subject
Item.Subject = "PROJ=5 " & Item.Subject
Item.Save
Set olForward = Item.Forward
'// add Recipent
olForward.Recipients.Add "Test#mail.com"
olBody = "<HTML><BODY><P>Append the Body with about 10 lines of text</P>" & vbNewLine & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P></HTML></BODY>" & vbNewLine
'// Forward Email
olForward.HTMLBody = olBody & vbCrLf & olForward.HTMLBody
'// Send or your use .Dispaly
olForward.Send
Set olApp = Nothing
Set olForward = Nothing
End Sub
I want to monitor a drive for file changes, using VBScript. I have the below code. It works fine for InstanceCreationEvent and InstanceDeletionEvent. But InstanceModificationEvent is not happening. From googling I got to know we need to use CIM_DataFile instead of CIM_DirectoryContainsFile to monitor InstanceModificationEvent. I am not sure how to modify the code. Can anyone help.
FYI: One script should monitor all the folders and subfolders in a drive.
PS: Any suggestion to improve the code and performance or other ideas also welcome.
My Code:
Dim arrFolders
Dim strComputer
Dim objWMIService
Dim strFolder
Dim strCommand
Dim i
Dim strQuery
strChangeFile = "MonitorFolder_Log.txt"
strMailIDFile = "MonitorFolder_MailIDs.txt"
'Check if the log file exists, if not ceate a new file and exit the script. Restart the script again.
Set oFSO = CreateObject("Scripting.FileSystemObject")
If not oFSO.FileExists(strChangeFile) then
'WScript.Echo "Change Log File Not Found. Creating new file..."
Set oTxtFile = oFSO.CreateTextFile(strChangeFile)
WScript.Echo strChangeFile & " File Created." & vbCrLf & "Please restart the script." & vbCrLf
WScript.Quit
End If
'Prompt for which drive should be monitored. If not a valid drive, then exit the script.
strDrive = InputBox("Enter the drive to monitor: " & vbCrLf & "E.g.: Input C to monitor C:\ drive.", "Monitor Folder - Oracle", "E")
If strDrive = "" then
WScript.Echo "Not a valid drive. Terminating the script."
WScript.Quit
End If
'Append ":" with the drive name.
strDrive = strDrive & ":"
'Read the mail IDs.
Set objFSOMailID = CreateObject("Scripting.FileSystemObject")
Set oTSMailID = objFSOMailID.OpenTextFile(strMailIDFile)
strMailIDsList = oTSMailID.ReadAll
oTSMailID.close
'WScript.Echo strMailIDsList
'Array to store the existing folder paths that should be monitored.
arrFolders = Array()
i = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubfolders FSO.GetFolder(strDrive)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
i = i + 1
folderPath = "" & Subfolder.Path & ""
folderPath = Replace(folderPath ,"\","\\\\")
ReDim Preserve arrFolders(i)
arrFolders(i) = folderPath
'Wscript.Echo i & " " & arrFolders(i)
ShowSubFolders Subfolder
Next
End Sub
'Set the first path to be the drive.
arrFolders(0) = strDrive & "\\\\"
'Use WMI query to get the file changes.
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
'Loop throught the array of folders setting up the monitor for Each
i = 0
For Each strFolder In arrFolders
'Create the event sink
'WScript.Echo "setup for folder: " & strFolder & vbLf
strCommand = "Set EventSink" & i & " = WScript.CreateObject" & "(""WbemScripting.SWbemSink"", ""SINK" & i & "_"")"
ExecuteGlobal strCommand
'Setup Notification
strQuery = "SELECT * " _
& "FROM __InstanceOperationEvent " _
& "WITHIN 1 " _
& "WHERE Targetinstance ISA 'CIM_DirectoryContainsFile'" _
& " AND TargetInstance.GroupComponent = " & "'Win32_Directory.Name=""" & strFolder & """'"
strCommand = "objWMIservice.ExecNotificationQueryAsync EventSink" & i & ", strQuery"
ExecuteGlobal strCommand
'Create the OnObjectReady Sub
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & "objAsyncContext)" & vbLf _
& " 'Wscript.Echo objObject.TargetInstance.PartComponent" & vbLf _
& " SendNotification(objObject)" & vbLf _
& "End Sub"
'WScript.Echo strCommand
ExecuteGlobal strCommand
i = i + 1
Next
'Wait for events.
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Function SendNotification(objObject)
strEventType = objObject.Path_.Class
strPartComp = Split(objObject.TargetInstance.PartComponent, "=")
strFileName = Replace(strPartComp(1), "\\", "\")
WScript.Echo strEventType
WScript.Echo strFileName
'Some more code to send mail and logs...
End Function
Monitoring the entire filesystem for file creation is not feasible. It will eat up system resources and might severly affect system operation. Only ever monitor selected folders. The following should work:
Const Interval = 1
Set monitor = CreateMonitor("C:\foo")
Do
Set evt = monitor.NextEvent()
Select Case evt.Path_.Class
Case "__InstanceCreationEvent" : SendNotification evt.TargetInstance
Case "__InstanceModificationEvent" : ...
Case "__InstanceDeletionEvent" : ...
End Select
Loop
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 " & Interval & _
" WHERE Targetinstance ISA 'CIM_DataFile'" & _
" AND TargetInstance.Drive='" & drv & "'" & _
" AND TargetInstance.Path='" & dir & "'"
Set CreateMonitor = wmi.ExecNotificationQuery(query)
End Function
Sub SendNotification(tgtInst)
'send notification
End Sub
You should run monitors for different folders as separate processes, because NextEvent() is a blocking operation.
I'm trying to move my entire User folder in Vista to a non-system partition. To do so with a minimum hassle I'm following the directions provided at Ben's Blog, specifically the vbs script he provides. However executing the script throws up an error which I can't resolve myself. Here's the vbs code followed by the text file it calls on, and finally my error message. Can someone help me correct the problem? (I really don't know much about VBS, so please write as simple as possible.)
VBS Code:
'# Perform dir /a c:\users > c:\dir.txt
'# place this script file in c:\ too
'# double click to run it
'# run resulting script.bat from recovery mode
repprefix = " Directory of..." ' Modify to your language
sourcedrive = "C:\"
targetdrive = "D:\"
altsourcedrive = "C:\" 'leave same as target drive unless otherwise indicated
alttargetdrive = "E:\" 'leave same as target drive unless otherwise indicated
inname = "dir.txt"
outname = "script.bat"
userroot = "Users"
set fso = CreateObject("Scripting.FileSystemObject")
' construct batch commands for saving rights, then link, the recreating rights
Function GetCommand(curroot, line, typ, keyword)
' first need to get source and target
pos = Instr(line, keyword) + Len(keyword)
tuple = Trim(Mid(line, pos))
arr = Split(tuple, "[")
oldtarget = Replace(arr(1), "]", "")
oldlink = curroot & "\" & Trim(arr(0))
' need to determine if we are pointing back to old disk
newlink = replace(oldlink, sourcedrive, targetdrive)
if(Instr(oldtarget, sourcedrive & userroot)) then
newtarget = Replace(oldtarget, sourcedrive, targetdrive)
else
newtarget = oldtarget ' still pointing to original target
end if
' comment
out = "echo " & newlink & " --- " & newtarget & vbCrLf
' save permissions
out = out & "icacls """ & replace(oldlink, sourcedrive, altsourcedrive) & """ /L /save " & altsourcedrive & "permissions.txt" & vbCrLf
' create link
newlink = replace(newlink, targetdrive, alttargetdrive)
if typ = "junction" then
out = out & "mklink /j """ & newlink & """ """ & newtarget & """" & vbCrLf
else ' typ = "symlink"
out = out & "mklink /d """ & newlink & """ """ & newtarget & """" & vbCrLf
end if
'set hidden attribute
out = out & "attrib +h """ & newlink & """ /L" & vbCrLf
' apply permissions
shortlink = Left(newlink, InstrRev(newlink, "\") - 1) 'icacls works strangely - non-orthogonal for restore
out = out & "icacls """ & shortlink & """ /L /restore " & altsourcedrive & "permissions.txt" & vbCrLf
GetCommand = out & vbCrLf
End Function
Sub WriteToFile(file, text)
ForWriting = 2
Create = true
set outfile = fso.OpenTextFile(file, ForWriting, Create)
Call outfile.Write(text)
Call outfile.Close()
End Sub
outtext = "ROBOCOPY " & altsourcedrive & userroot & " " & alttargetdrive & userroot & " /E /COPYALL /XJ" & vbCrLf & vbCrLf
set intext = fso.OpenTextFile(inname)
while not intext.AtEndOfStream
line = intext.ReadLine()
if Instr(line, repprefix) then
curroot = Replace(line, repprefix, "")
elseif Instr(line, juncname) then
outtext = outtext & GetCommand(curroot, line, "junction", juncname)
elseif Instr(line, linkname) then
outtext = outtext & GetCommand(curroot, line, "symlink", linkname)
end if
Wend
outtext = outtext & "icacls " & altsourcedrive & userroot & " /L /save " & altsourcedrive & "permissions.txt" & vbCrLf
outtext = outtext & "ren " & altsourcedrive & userroot & " _" & userroot & vbCrLf
outtext = outtext & "mklink /j " & altsourcedrive & userroot & " " & targetdrive & userroot & vbCrLf
outtext = outtext & "icacls " & altsourcedrive & " /L /restore " & altsourcedrive & "permissions.txt"
Call intext.Close()
Call WriteToFile(outname, outtext)
MsgBox("Done writing to " & outname)
dir.txt:
Volume in drive C is ACER
Volume Serial Number is 08D7-C0CC
Directory of c:\users
07/16/2009 12:29 PM <DIR
07/16/2009 12:29 PM <DIR> ..
11/02/2006 09:02 AM <SYMLINKD> All Users [C:\ProgramData]
11/02/2006 09:02 AM <DIR> Default
11/02/2006 09:02 AM <JUNCTION> Default User [C:\Users\Default]
08/21/2008 08:37 AM 174 desktop.ini
11/02/2006 08:50 AM <DIR> Public
07/19/2009 08:54 PM <DIR> Steve
1 File(s) 174 bytes
7 Dir(s) 5,679,947,776 bytes free
Error Message:
Windows Script Host
Script: C:\userlocationchange.vbs
Line: 25
Char: 2
Error: Subscript out of range: '[number: 1]'
Code: 800A0009
Source: Microsoft VBScript runtime error
The problem is at these lines:
arr = Split(tuple, "[")
oldtarget = Replace(arr(1), "]", "")
I assume that arr(1) is giving the error because arr has only one entry - and since arrays are zero-based in VBS, that entry should be accessed as arr(0).
Hmmm... if there's only one entry, then presumably no "[" was found. The code probably needs to check for that (by testing whether UBound(arr) > 1).
What that means in a wider context - i.e. why there's no "[" I can't say.
EDIT: OK, I took a look at the blog you referred to, and the exact same problem was reported. The blog author replied:
A couple of pointers: look in the txt
file output by the dir command. On my
system, the targets of the symlinks
are shown in square brackets [].
Apparently in your case there aren't
any - in any case that is a hypothesis
that would explain why the script
can't parse out the link targets.
...which pretty much confirms my theory. I suggest you do as he suggests and take a look at the txt file to see if some other character is used.
Note that this isn't really a problem with the script per se - it's just that the script expects some input that it's not getting.
#Gary, I'm the same one who reported the problem on that blog.
I posted the txt file here under the VBS code. My txt file also has the symlink-junction targets within square brackets. Is there anything else I'm missing?