find pst, and backup to a network share

[rod602]

Greetings all,

I found this code online, and modified a little with my elementary coding skills. Basically I am hoping to achieve is that every friday dump the pst from a user to a network share. I am hoping someone could aid me in finishing this code .

Here are the parts I need.
1) Need to find ip of machine and compare it to 10.0.1.x. If that ip is within subnet, then I can run code as long as it is also friday today.
2) Copy pst to a network share.

My goal is to put script in Group Policy under logoff script, but I only want the main part of the code to run if it is friday, and the user is in a particular subnet( we have mobile users).

Thanks all

Set oOutlook = CreateObject("Outlook.Application")
Set oNS = oOutlook.GetNamespace("MAPI")

'only run this entire code if today is friday and the ip of this
'computer is in subnet 10.0.1.x
'todo1: if today is friday and with are in subnet 10.0.1.x run 
'rest of code

dim paths(3)
path = ""
x = 0
For Each oFolder In oNS.Folders
     path = GetPSTPath(Replace(oFolder.StoreID, "00", ""))
	if path	<> "" then
		paths(x) = path
		WScript.Echo paths(x), "(" & oFolder.Name & ")"
	    x = x+1
	end if
	
	
Next
Set oNS = Nothing
Set oOutlook = Nothing

Set oWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set cServices = oWMIService.ExecQuery _
    ("Select * From Win32_Process where Name = 'Outlook.exe'")
For Each oApp In cServices
    oApp.Terminate
Next

'have paths in array copy to network shares.  
'have x number of paths. 
'todo2: pull path from array and copy to network share


'Translate a hex string to character and extract the path
Function GetPSTPath(input)
    sPath = ""
    For i = 1 To Len(input) Step 2
        sPath = sPath & ChrW("&H" & Mid(input,i,2))
    Next

    p = InStr(sPath, ":\")
    q = InStr(sPath, "\\")
    If  p > 0 Then GetPSTPath = Mid(sPath,p-1)
    If  q > 0 Then GetPSTPath = Mid(sPath,q-1)
End Function

 

[jges]

Here is a code snippet to determine if it is Friday or not.

If WeekDay(Now(), 1) = 6 then
  'it is Friday!
  'add code to run on Friday
  
End If

The snippet makes use of the weekday function, for more information reference:

http://msdn.microsoft.com/en-us/library/t51x9wtx(v=vs.85).aspx

http://www.w3schools.com/vbscript/func_weekday.asp

Here is a webpage with code to find the local ip address (I have not tested it):

http://www.codeproject.com/KB/vbscript/ipaddress.aspx

 

[rod602]

@jges

Thank you for your assistance.

 

[Geates]

Assuming wireless is disabled, get all IP enabled NICs and get the IP of the first one. Parse the IP and match it against the VLAN you are looking for (10.0.1). If the IP is verified and it's Friday, copy the source file to the destination folder and overwrite if it already exists

strComputer = "." 'Local computer
strVLAN = "10.0.1"
strSource = "C:\pathToPST\archive.pst"
strDestination = "\\server\share\"

set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
set colNIC = objWMI.ExecQuery("Select * From Win32_NetworkAdapterConfiguration where IPEnabled=1",,48)
set objFSO = CreateObject("Scripting.FileSystemObject")

for each objNIC in colNIC
    strIP = join(objNIC.IPAddress, "|")
next

intPos = inStr(strIP, "|")
if (intPos) then strIP = left(strIP, intPos)
if (left(strIP, len(strVLAN)) = strVLAN) then 
    if (weekDay(now, 1) = 6) then
        objFSO.CopyFile strSource, strDestination, true
    end if
end if

-Geates



"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[rod602]

@Geates thanks for your reply. I will put together code and test out.

 

[Geates]

actually, these lines are redundant

intPos = inStr(strIP, "|")
if (intPos) then strIP = left(strIP, intPos)

-Geates

"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[rod602]

Hey guys,

I finally implemented script on our logoff script and it works great.

Thanks for all the help, the only issue I am seeing is if a user logs off and their is no outlook profile configured as they log off the outlook setup wizard pops up.

Is there any way of figuring out if an outlook profile is configured ?

Thanks

 

[Geates]

If the user has not configured outlook, there will be no Outlook folder in the user's profile.

This work on both XP and 7.

set objFSO = CreateObject("Scripting.FileSystemObject")
set objNetwork = CreateObject("WScript.Network")
strUsername = objNetwork.Username

strOutlookFolder = "c:\Documents and Settings\" & strUsername & "\Application Data\Microsoft\Outlook"
if (objFSO.FolderExists(strOutlookFolder)) then
	'configured
else
	'not configured
end if

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[rod602]

Hey Guys,

Just ran into another issue, trying to debug with little success. This part of the code is not generating any pst paths for a certain computer. I have logged onto that system and the user has 3 pst files. Yet this function is not returning any paths. Any assistance in debugging and diagnosing what is going on with this computer?

dim paths(3)
path = ""
x = 0
For Each oFolder In oNS.Folders
     path = GetPSTPath(Replace(oFolder.StoreID, "00", ""))
    if path    <> "" then
        paths(x) = path
        WScript.Echo paths(x), "(" & oFolder.Name & ")"
        x = x+1
    end if
    
    
Next

'Translate a hex string to character and extract the path
Function GetPSTPath(input)
    sPath = ""
    For i = 1 To Len(input) Step 2
        sPath = sPath & ChrW("&H" & Mid(input,i,2))
    Next

    p = InStr(sPath, ":\")
    q = InStr(sPath, "\\")
    If  p > 0 Then GetPSTPath = Mid(sPath,p-1)
    If  q > 0 Then GetPSTPath = Mid(sPath,q-1)
End Function

 

[rod602]

Here is an update. I am now getting an error.

I am running the code independently in a separate script and I am getting this.

error:'could not create object named outlook.application'
code:8007007e
source:wscript.createobject

 

[Geates]

remove any on error resume next

does oFolder.StoreID return anything?

Where did outlook.application come from? In none of the code do I see it or a reference to it. This error is typically caused when Outlook is not installed on the machine.

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[rod602]

@Geates,

No. I think the call to

Set oOutlook = CreateObject("Outlook.Application")
Set oNS = oOutlook.GetNamespace("MAPI")

is the issue. ON this particular computer, the error generated is the error mentioned above. Which leads me to believe something is broken with the scripting engine or something.

Any suggestions?

 

[Geates]

More likely, something is broken with Outlook. A broken scripting engine is about as common as a 6-fingered man who killed Inigo Montoya's father. Verify the installation of Outlook. Reinstall if necessary.

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[markdmac]

I see posts like this all of the time. You should not be copying the PST like this because Outlook may still have a hold of the PST and that will cause some issues with potential corruption of the PST. Microsoft has a free tool for doing what you want. Use that instead.

http://www.microsoft.com/download/en/details.aspx?displaylang=en&id=9003

I hope that helps.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[rod602]

@Mark,

Hi Mark. My code actually kills the outlook.exe process before trying to do anything. So in regards to that I have no worries. I did actually try the pf backup from MS, but I found it to be clunkly. And in my environment I have outlook 2003, 2007, 2010 and it didn't work as smoothly as I liked. This scripting solution happens upon log off once a week, and so far is awesome.

 

[rod602]

@Geates

you where correct. I uninstalled ms office and re-installed and the script worked..... thank goodness office 2003 is /was so lean. I was able to re-install quickly.

So the issue was something with outlook.

Thanks

Rigo