• RSS
  • Twitter
  • FaceBook

Exchange Server Forums

Forums | Register | Login | My Profile | Inbox | RSS RSS icon | My Subscription | My Forums | Address Book | Member List | Search | FAQ | Ticket List | Log Out

vbscript to auto create outlook\exchange profile

Users viewing this topic: none

Logged in as: Guest
  Printable Version
All Forums >> [Microsoft Exchange 2003] >> General >> vbscript to auto create outlook\exchange profile Page: [1]
Login
Message << Older Topic   Newer Topic >>
vbscript to auto create outlook\exchange profile - 12.May2005 5:10:00 AM   
marinhd

 

Posts: 2
Joined: 28.Mar.2005
From: San Rafael
Status: offline
I have an organization with multiple branch offices with slow connections so roaming profiles is out of the question. When users move between branches the machine they log on to does not have a profile created. I would like a vbscript that users could execute which would automatically crate a profile in outlook using a specific exchange server name and pulling the logged on username for the mail account to be used.

Thanks,

Mark
Post #: 1
RE: vbscript to auto create outlook\exchange profile - 12.May2005 9:20:00 PM   
marcus2v

 

Posts: 17
Joined: 11.Nov.2001
From: UK
Status: offline
Borrowed from Mick Mason - sorry I would post a link but I can't for the life of me find it now! [Smile] but all rights/kudos/royalties! to him

code:
'**** Profile Wizard 1.0.3
'**** Creates MAPI profiles for Outlook 2000, XP and 2003
'**** Author - Mick Mason
'**** Version History
'**** V1.0.0 - 25.02.05
'**** V1.0.1 - 28.02.05 Checks for different versions of Outlook
'**** and creates the profile using the correct method for each
'**** version.
'**** V1.0.2 - 29.02.05 Only adds PAB with latest date. Adding multiple
'**** PABs is invalid for Outlook and causes profile generation to fail.
'**** V1.0.3 - 02.03.05 Runs outlook with /ImportPRF switch
'**** V1.0.4 - 03.03.05 For Outlook 2002/3 no command is called. Instead
'**** a registry entry is changed that causes Outlook to import the PRF the
'**** next time a user starts Outlook.
'**** V1.0.5 Uses relative paths. Checks to make sure registry value exists
'**** before trying to delete it - uses routine by Mike Bouchard



'Require all variables to be DIM'd
Option Explicit

'Define constants for use in script
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const ReadOnly = 1
Const HKCR = &H80000000
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKUS = &H80000003

Dim Wsh 'Shell object
Dim objOLK 'Object to hold instance of Outlook
Dim OLKVer 'First digit of Outlook Version number
Dim OLPath 'Path to Outlook.exe
Dim strDirName 'The path to search for PSTs and PABs
Dim refWMIService 'WMI Object
Dim refDirectory 'Handle to directory
Dim objNet 'Handle to Network object
Dim strUName 'Users login name
Dim pCurrentDir 'Directory name passed to the EnumerateFiles function
Dim PSTs 'Variable used in function. Contains an array of PSTs
Dim PABs 'Variable used in function. Contains an array of PABs
Dim RetVal 'Generic holder for return values

'Create an instance of Outlook so that it can be queried for it's version
Set objOLK = CreateObject("Outlook.Application")
'Extract the first digit from the version number (this is the major version number)
OLKVer = left(objOLK.Version,inStr(1,objOLK.Version,".")-1)
'Close the instance of Outlook
objOLK.Quit

'If Outlook version is later than 2000 then make this registry change so that Outlook imports the PRF on first run
If OLKVer > 9 Then
Set Wsh = CreateObject("Wscript.Shell")
If CheckRegKey("HKEY_CURRENT_USER\Software\Microsoft\Office\" & OLKVer & ".0\Outlook\Setup\First-Run") = TRUE Then
RetVal = Wsh.RegDelete("HKEY_CURRENT_USER\Software\Microsoft\Office\" & OLKVer & ".0\Outlook\Setup\First-Run")
End If
RetVal = Wsh.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Office\" & OLKVer & ".0\Outlook\Setup\ImportPRF","h:\Exchange\Outlook.prf")
Set Wsh = Nothing
End If

'Define the path to the PSTs and PABs
strDirName = "h:\exchange"

'Create a WMI object to be used in the EnumerateFiles function
Set refWMIService = GetObject("winMgmts:")
'Get a handle to the directory specified in strDirName
Set refDirectory = GetObject("winMgmts:Win32_Directory='" & strDirName & "'")
'Create a network object, then use it to get the users login name
Set objNet = CreateObject("WScript.NetWork")
strUName = objNet.UserName

'Call function to enumerate all PSTs and the latest PAB in strDirName folder
EnumerateFiles(refDirectory)

'Close WMI and Directory objects
set refDirectory = Nothing
set refWMIService = Nothing

'Display completion message
Wscript.Echo "Profile created for " & strUName
'******************** END OF SCRIPT ********************



'***** FUNCTIONS *****

'**** GetVBDate(Timestamp)
'Converts a VBScript date stamp to a human readable format
Function GetVBDate(ts)
GetVBDate = DateSerial(left(ts,4),mid(ts,5,2),mid(ts,7,2)) + Timeserial(mid(ts,9,2),mid(ts,11,2),mid(ts,13,2))
End Function

'**** CheckRegKey(RegStr)
Function CheckRegKey(RegStr)
On Error Resume Next
Wsh.RegRead RegStr
If Err Then
CheckRegKey = False
Else
CheckRegKey = True
End If
On Error Goto 0
End Function

'**** EnumerateFiles(Path to enumerate)
'Checks a given path and creates an array of all PST files in the folder. It also
'gets the name of the most recent PAB. Multiple PAB Services are not supported in
'Outlook
Function EnumerateFiles(pCurrentDir)

Dim strQuery 'Holds WMI query
Dim colFiles 'Result set containing list of files in specified folder
Dim refFileItem 'Current working file from list of files
ReDim arrPST(-1) 'Create array to hold PSTs using an invalid index (used to check if it's empty)
ReDim arrPAB(-1) 'Create array to hold PABs using an invalid index (used to check if it's empty)
Dim verRet 'Contains return value from the profile creation function
Dim DateComp 'Gets updated with the date of the most recent PAB file
Dim PABDate 'Last accessed date of PAB file
Dim PABName 'Gets updated with the name of the most recent PAB

'Create WMI query to get list of all files in specified directory
strQuery = "ASSOCIATORS OF {Win32_Directory='" & pCurrentDir.Name & "'} WHERE AssocClass=CIM_DirectoryContainsFile " & "Role=GroupComponent ResultRole=PartComponent"
'Execute query and put result set in colFiles
set colFiles = refWMIService.ExecQuery(strQuery)

'Repeat this loop for all items in the result set of files
For Each refFileItem in colFiles
'Check to see if file extension is PST
If UCASE(Right(refFileItem.Name,3)) = "PST" Then
'Check to see if PST Array is still empty
If UBound(arrPST) = -1 Then
'Re-Dimension array and add first item
ReDim arrPST(0)
arrPST(0) = refFileItem.Name
'If array isn't empty
Else
'Re-dimension it to current size + 1
ReDim Preserve arrPST(UBound(arrPST) + 1)
'Add next item
arrPST(Ubound(arrPST)) = refFileItem.Name
End If
End if
'End loop
Next

'Repeat this loop for all items in the result set of files
DateComp = 0
For Each refFileItem in colFiles
'Check to see if file extension is PAB
If UCASE(Right(refFileItem.Name,3)) = "PAB" Then
'Check to see if PAB Array is still empty
PABDate = GetVBDate(refFileItem.LastModified)
If DateDiff("n",DateComp,PABDate) > 0 Then
DateComp = PABDate
PABName = refFileItem.Name
End If
End if
'End loop
Next

'Check version of Outlook, and call the corresponding function to
'create the MAPI profile

Select Case OLKVer
Case 9
verRet = Outlook2K(arrPST,PABName)
Case 10
verRet = Outlook2K3XP(arrPST,PABName)
Case 11
verRet = Outlook2K3XP(arrPST,PABName)
End Select

'Close the files object
set colFiles = Nothing
'End the function
End Function

'**** Outlook2K(PST Array, PAB Array)
'Creates a MAPI profile for Outlook 2000 users. Uses dynamically creates the
'h:\Exchange\Outlook.prf file from the Dummy2K.prf template, then calls Modprof.exe to create
'the profile.
Function Outlook2K(PSTs,PABs)
Dim fso 'Handle to File System Object
Dim wsh 'Handle to Windows Scripting Host
Dim copyRet 'Return value from Copy function
Dim ServiceData 'String containing list of services to be added to profile
Dim PSTNum 'Number assigned to PST service in h:\Exchange\Outlook.prf
Dim PABNum 'Number assigned to PAB service in h:\Exchange\Outlook.prf
Dim ServiceDetails 'String containing details of services to be added to profile
Dim PSTIndex 'Counter representing the array index for PSTs
Dim PSTItem 'Current PST being worked on
Dim fsoFile 'Handle to Dummy2k.prf template file
Dim fsoTextStream 'Textstream object to allow modification of newly created h:\Exchange\Outlook.prf
Dim strOldPrf 'Contents of Dummy2k.prf
Dim vbsRegExp 'Regular expression variable used in search and replace functions
Dim strNewPrf1 'String used to replace 'LoggedInUserName' in h:\Exchange\Outlook.prf
Dim strNewPrf2 'String used to replace 'ServiceData' in h:\Exchange\Outlook.prf
Dim strNewPrf3 'String used to replace 'ServiceDetails' in h:\Exchange\Outlook.prf
Dim strCommand 'String containing shell command that is executed by wsh object
Dim retVal 'Contains return value from wsh command execution

'Create handle to File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Use fso to copy the template file to h:\Exchange\Outlook.prf.
copyRet = fso.CopyFile ("dummy2k.prf","h:\Exchange\Outlook.prf")

'Initialise variables
'ServiceData will contain a string of all the services that need to be added into the
'vanilla h:\Exchange\Outlook.prf
ServiceData = ""
'Service 1 & 2 & 4 already exist in h:\Exchange\Outlook.prf, so start the service number at 3
PSTNum = 3
'If the PST isn't empty
If Not UBound(PSTs) = -1 Then
'Do this loop for each PST in the array
For Each PSTItem in PSTs
'Create the entry for the list of services in h:\Exchange\Outlook.prf
ServiceData = ServiceData & "Service" & PSTNum & "=Personal Folders" & vbCrLf
'******** SERVICE NUMBER WARNING *********
'The service numbers in h:\Exchange\Outlook.prf need to be consecutive, even if they aren't displayed
'in the right order. 1 & 2 & 4 already exist. Therefore, the first service we add needs
'to be number three. However, because 4 is already used, the second service we add needs
'to be number 5. The statement below checks to see if this if the first service we are
'adding, if it is, it increments the PSTnum by 2, so that it's new value is 5. If it's
'not the first, it simply increments it by one.
If PSTNum = 3 Then
PSTNum = PSTNum + 2
Else
PSTNum = PSTNum + 1
End If
Next
Else
'If the array is empty, it just creates a single entry for a new PST
ServiceData = ServiceData & "Service" & PSTNum & "=Personal Folders" & vbCrLf
'Check to see if this is the first service dynamically created (see SERVICE NUMBER WARNING above)
If PSTNum = 3 Then
PSTNum = PSTNum + 2
Else
PSTNum = PSTNum + 1
End If
End If

'Set PABNum = PSTNum. As PSTNum was incremented by one at the end of the last conditional statement
'it is now the next consecutive number for the list of services
PABNum = PSTNum
ServiceData = ServiceData & "Service" & PABNum & "=Personal Address Book" & vbCrLf

'Initialise variables
'ServiceDetails will be a string contain the details for all the services we are adding into h:\Exchange\Outlook.prf
ServiceDetails = ""
'Set the service number back to 3. This is so the service details have the same number as the
'services listed in the service list (ServiceData)
PSTNum = 3
'Set the array index to 0 so that we start at the first item in the PST array
PSTIndex = 0
'If the array isn't empty
If Not UBound(PSTs) = -1 Then
'Do this loop for each PST in the array
For Each PSTItem in PSTs
'Build the entry for the current PST to be inserted into h:\Exchange\Outlook.prf
ServiceDetails = ServiceDetails & "[Service" & PSTNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "EncryptionType=0x80000000" & vbCrLF
ServiceDetails = ServiceDetails & "PathToPersonalFolders=" & PSTs(PSTIndex) & vbCrLf
ServiceDetails = ServiceDetails & vbCrLf
'(see SERVICE NUMBER WARNING above)
If PSTNum = 3 Then
PSTNum = PSTNum + 2
Else
PSTNum = PSTNum + 1
End If
'Increment the PST array index by one so that we will work on the next PST in the
'next iteration of this loop
PSTIndex = PSTIndex +1
Next
'If array is empty, just create a single entry for a new PST called <username>.pst
Else
ServiceDetails = ServiceDetails & "[Service" & PSTNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "EncryptionType=0x80000000" & vbCrLf
ServiceDetails = ServiceDetails & "PathToPersonalFolders=" & strDirName & "\" & strUName & ".PST" & vbCrLf
ServiceDetails = ServiceDetails & vbCrLf
'(see SERVICE NUMBER WARNING above)
If PSTNum = 3 Then
PSTNum = PSTNum + 2
Else
PSTNum = PSTNum + 1
End If
End If
'Set the PAB Service number to be the same as the PST service number, which is now
'one greater than the last number we used for the last PST service
PABNum = PSTNum

If Not PABs = "" Then
ServiceDetails = ServiceDetails & "[Service" & PABNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "PathToPersonalAddressBook=" & PABs & vbCrLf
ServiceDetails = ServiceDetails & "ViewOrder=0" & vbCrLf
Else
ServiceDetails = ServiceDetails & "[Service" & PABNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "PathToPersonalAddressBook=" & strDirName & "\" & strUName & ".PAB" & vbCrLf
ServiceDetails = ServiceDetails & "ViewOrder=0" & vbCrLf
End If

'Close the current file system object which was used to copy dummy2k.prf to h:\Exchange\Outlook.prf
Set fso = Nothing

'Create a new file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'Use the fso to get a handle to dummy2k.prf
Set fsoFile = fso.GetFile("Dummy2K.Prf")
'Open dummy2k.prf as a text file (textStream object) in read mode
Set fsoTextStream = fso.OpenTextFile("Dummy2K.prf", ForReading)
'Pull the entire contents of the template file into a variable called strOldprf
strOldPrf = fsoTextStream.ReadAll
'Close the textstream object
fsoTextStream.Close

'Create a new regular expression object
Set vbsRegExp = New RegExp
'Define the Pattern that we wish to search for
vbsRegExp.Pattern = "LoggedInUserName"
'Set the Reg Exp options
vbsRegExp.Global = True
vbsRegExp.IgnoreCase = True
'Replace our search pattern (LoggedInUserName) with strUName (which is the users login name)
'We perform the search within strOldPrf, which is the entire contents of the Dummy2K.prf file
strNewPrf1 = vbsRegExp.Replace(strOldPrf,strUName)
'Close the Reg Exp
Set vbsRegExp = Nothing

'Create a new reg exp object and do the same as above with a different pattern
Set vbsRegExp = New RegExp
vbsRegExp.Pattern = "LabelServiceData"
vbsRegExp.Global = True
vbsRegExp.IgnoreCase = True
'Replace our search pattern (LabelServiceData) with ServiceData (which is the list of services)
'We perform the search within strNewPrf1, which is the output of the above search and replace
strNewPrf2 = vbsRegExp.Replace(strNewPrf1,ServiceData)
'Close the Reg Exp
Set vbsRegExp = Nothing

'Create a new reg exp object and do the same as above with a different pattern
Set vbsRegExp = New RegExp
vbsRegExp.Pattern = "LabelServiceDetails"
vbsRegExp.Global = True
vbsRegExp.IgnoreCase = True
'Replace our search pattern (LabelServiceDetails) with ServiceDetails (which is the service details)
'We perform the search within strNewPrf2, which is the output of the above search and replace
strNewPrf3 = vbsRegExp.Replace(strNewPrf2,ServiceDetails)
'strNewPrf3 now contains all the changes from the search and replace functions we have performed
'Close the Reg Exp
Set vbsRegExp = Nothing

'Create a new text stream object to the h:\Exchange\Outlook.prf file we created earlier
'When a text stream object is opened in ForWriting mode, anything written to it
'will overwrite it's current contents
Set fsoTextStream = fso.OpenTextFile("h:\Exchange\Outlook.prf", ForWriting)
'Write our string containing all the changes into the text stream object
fsoTextStream.Write strNewPrf3
'Close the text stream
fsoTextStream.Close
'Close the file system object
Set fso = Nothing
'Create a Shell object so that we can run a shell command
Set wsh = WScript.CreateObject("WScript.Shell")
'Create the command line that we intend to run
strCommand = "modprof -p h:\Exchange\Outlook.prf"
'Run the command and stick the return value into retVal
retVal = wsh.Run (strCommand,7,1)
'Close the Shell object
Set wsh = Nothing
'End the function
End Function

'**** Outlook2K3XP(PST Array, PAB Array)
'Creates a MAPI profile for Outlook XP and 2003 users. Dynamically creates the
'h:\Exchange\Outlook.prf file from the Dummy2K3XP.prf template, then calls the h:\Exchange\Outlook.prf directly
'to create the profile. It does exactly the same as the function above, but puts it in
'the correct format for Outlook XP and 2003
Function Outlook2K3XP(PSTs,PABs)
Dim fso 'Handle to File System Object
Dim wsh 'Handle to Windows Scripting Host
Dim copyRet 'Return value from Copy function
Dim ServiceData 'String containing list of services to be added to profile
Dim PSTNum 'Number assigned to PST service in h:\Exchange\Outlook.prf
Dim PABNum 'Number assigned to PAB service in h:\Exchange\Outlook.prf
Dim ServiceDetails 'String containing details of services to be added to profile
Dim PSTIndex 'Counter representing the array index for PSTs
Dim PSTItem 'Current PST being worked on
Dim fsoFile 'Handle to Dummy2k.prf template file
Dim fsoTextStream 'Textstream object to allow modification of newly created h:\Exchange\Outlook.prf
Dim strOldPrf 'Contents of Dummy2k.prf
Dim vbsRegExp 'Regular expression variable used in search and replace functions
Dim strNewPrf1 'String used to replace 'LoggedInUserName' in h:\Exchange\Outlook.prf
Dim strNewPrf2 'String used to replace 'ServiceData' in h:\Exchange\Outlook.prf
Dim strNewPrf3 'String used to replace 'ServiceDetails' in h:\Exchange\Outlook.prf
Dim strCommand 'String containing shell command that is executed by wsh object
Dim retVal 'Contains return value from wsh command execution

'Create handle to File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Use fso to copy the template file to h:\Exchange\Outlook.prf.
copyRet = fso.CopyFile ("dummy2k3.prf","h:\Exchange\Outlook.prf")

'Initialise variables
'ServiceData will contain a string of all the services that need to be added into the
'vanilla h:\Exchange\Outlook.prf
ServiceData = ""
'Service 1 already exists in h:\Exchange\Outlook.prf, so start the service number at 2
PSTNum = 2
'If the PST isn't empty
If Not UBound(PSTs) = -1 Then
'Do this loop for each PST in the array
For Each PSTItem in PSTs
'Create the entry for the list of services in h:\Exchange\Outlook.prf
ServiceData = ServiceData & "Service" & PSTNum & "=Unicode Personal Folders" & vbCrLf
'Increment PST service number
PSTNum = PSTNum + 1
Next
Else
'If the array is empty, it just creates a single entry for a new PST
ServiceData = ServiceData & "Service" & PSTNum & "=Unicode Personal Folders" & vbCrLf
PSTNum = PSTNum + 1
End If

PABNum = PSTNum
'Set PABNum = PSTNum. As PSTNum was incremented by one at the end of the last conditional statement
'it is now the next consecutive number for the list of services
ServiceData = ServiceData & "Service" & PABNum & "=Personal Address Book" & vbCrLf

'Initialise variables
'ServiceDetails will be a string contain the details for all the services we are adding into h:\Exchange\Outlook.prf
ServiceDetails = ""
PSTNum = 2
'Set the array index to 0 so that we start at the first item in the PST array
PSTIndex = 0
'If the array isn't empty
If Not UBound(PSTs) = -1 Then
'Do this loop for each PST in the array
For Each PSTItem in PSTs
'Build the entry for the current PST to be inserted into h:\Exchange\Outlook.prf
ServiceDetails = ServiceDetails & "[Service" & PSTNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "UniqueService=No" & vbCrLF
ServiceDetails = ServiceDetails & "Name=Personal Folders" & vbCrLF
ServiceDetails = ServiceDetails & "PathToPersonalFolders=" & PSTs(PSTIndex) & vbCrLf
ServiceDetails = ServiceDetails & "EncryptionType=0x40000000" & vbCrLF
ServiceDetails = ServiceDetails & vbCrLf
PSTNum = PSTNum + 1
'Increment the PST array index by one so that we will work on the next PST in the
'next iteration of this loop
PSTIndex = PSTIndex +1
Next
'If array is empty, just create a single entry for a new PST called <username>.pst
Else
ServiceDetails = ServiceDetails & "[Service" & PSTNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "UniqueService=No" & vbCrLF
ServiceDetails = ServiceDetails & "Name=Personal Folders" & vbCrLF
ServiceDetails = ServiceDetails & "PathToPersonalFolders=" & strDirName & "\" & strUName & ".PST" & vbCrLf
ServiceDetails = ServiceDetails & "EncryptionType=0x40000000" & vbCrLF
ServiceDetails = ServiceDetails & vbCrLf
PSTNum = PSTNum + 1
End If

'Set the PAB Service number to be the same as the PST service number, which is now
'one greater than the last number we used for the last PST service
PABNum = PSTNum
If Not PABs = "" Then
ServiceDetails = ServiceDetails & "[Service" & PABNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "NameOfPAB=""Personal Address Book""" & vbCrLf
ServiceDetails = ServiceDetails & "Path=" & PABs & vbCrLf
ServiceDetails = ServiceDetails & "ShowNamesBy=0" & vbCrLf
Else
ServiceDetails = ServiceDetails & "[Service" & PABNum & "]" & vbCrLf
ServiceDetails = ServiceDetails & "NameOfPAB=""Personal Address Book""" & vbCrLf
ServiceDetails = ServiceDetails & "Path=" & strDirName & "\" & strUName & ".PAB" & vbCrLf
ServiceDetails = ServiceDetails & "ShowNamesBy=0" & vbCrLf
End If

'Close the current file system object which was used to copy dummy2k.prf to h:\Exchange\Outlook.prf
Set fso = Nothing

'Create a new file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'Use the fso to get a handle to dummy2k3.prf
Set fsoFile = fso.GetFile("Dummy2k3.Prf")
'Open dummy2k3.prf as a text file (textStream object) in read mode
Set fsoTextStream = fso.OpenTextFile("Dummy2K3.prf", ForReading)
'Pull the entire contents of the template file into a variable called strOldprf
strOldPrf = fsoTextStream.ReadAll
'Close the textstream object
fsoTextStream.Close

'Create a new regular expression object
Set vbsRegExp = New RegExp
'Define the Pattern that we wish to search for
vbsRegExp.Pattern = "LoggedInUserName"
'Set the Reg Exp options
vbsRegExp.Global = True
vbsRegExp.IgnoreCase = True
'Replace our search pattern (LoggedInUserName) with strUName (which is the users login name)
'We perform the search within strOldPrf, which is the entire contents of the Dummy2K3.prf file
strNewPrf1 = vbsRegExp.Replace(strOldPrf,strUName)
'Close the Reg Exp
Set vbsRegExp = Nothing

'Create a new reg exp object and do the same as above with a different pattern
Set vbsRegExp = New RegExp
vbsRegExp.Pattern = "LabelServiceData"
vbsRegExp.Global = True
vbsRegExp.IgnoreCase = True
'Replace our search pattern (LabelServiceData) with ServiceData (which is the list of services)
'We perform the search within strNewPrf1, which is the output of the above search and replace
strNewPrf2 = vbsRegExp.Replace(strNewPrf1,ServiceData)
'Close the Reg Exp
Set vbsRegExp = Nothing

'Create a new reg exp object and do the same as above with a different pattern
Set vbsRegExp = New RegExp
vbsRegExp.Pattern = "LabelServiceDetails"
vbsRegExp.Global = True
vbsRegExp.IgnoreCase = True
'Replace our search pattern (LabelServiceDetails) with ServiceDetails (which is the service details)
'We perform the search within strNewPrf2, which is the output of the above search and replace
strNewPrf3 = vbsRegExp.Replace(strNewPrf2,ServiceDetails)
'strNewPrf3 now contains all the changes from the search and replace functions we have performed
'Close the Reg Exp
Set vbsRegExp = Nothing

'Create a new text stream object to the h:\Exchange\Outlook.prf file we created earlier
'When a text stream object is opened in ForWriting mode, anything written to it
'will overwrite it's current contents
Set fsoTextStream = fso.OpenTextFile("h:\Exchange\Outlook.prf", ForWriting)
'Write our string containing all the changes into the text stream object
fsoTextStream.Write strNewPrf3
'Close the text stream
fsoTextStream.Close
'Close the file system object
Set fso = Nothing

'End the function
End Function


(in reply to marinhd)
Post #: 2
RE: vbscript to auto create outlook\exchange profile - 21.Aug.2007 4:13:41 AM   
mill99

 

Posts: 1
Joined: 21.Aug.2007
Status: offline
Hi,

I'was searching a way to reconnect the PST file from an OLD outlook profile to a new one.

Thank a lot for your post ;-)

But, can you post the content of the dummy.prf file plz ?

Best regards,

Mīll#99

(in reply to marcus2v)
Post #: 3

Page:   [1] << Older Topic    Newer Topic >>
All Forums >> [Microsoft Exchange 2003] >> General >> vbscript to auto create outlook\exchange profile Page: [1]
Jump to:

New Messages No New Messages
Hot Topic w/ New Messages Hot Topic w/o New Messages
Locked w/ New Messages Locked w/o New Messages
 Post New Thread
 Reply to Message
 Post New Poll
 Submit Vote
 Delete My Own Post
 Delete My Own Thread
 Rate Posts


Follow TechGenix on Twitter