********Fix to original code*******It now generates the time zone that you would want, check the comments.
I was presented with the request that prior to applying the OS patch for 2007 DST that we capture all user’s calendars in a printable format. To do this I leveraged the DWA functionality that generates PDF’s of peoples calendars. I just set the configuration that I wanted in the DWA print dialog and then captured the URL that was generated.
I use that URL in the vbs below to generate pdf files for all the user’s mail files that are listed in a separate configuration text file that you can create.
Thanks to Eric Phelps at www.ericphelps.com for his savewebbinary function which is in modified form below.
Save the following as a vbs, read to comments for configuration:
'Instructions********
'You need to create a text input file with the following info
'server,mailfilepath,mailusername,pdffilename
'here is an example:
'usmail01.technotics.com,/mail/jaggerm.nsf,Mick Jager,c:\calprints\MickJager.pdf
'usmail02.technotics.com,/mail/popi.nsf,Iggy Pop,c:\calprints\IggyPop.pdf
'usmail01.technotics.com,/mail/strummerj.nsf,Joe Strummer,c:\calprints\JoeStrummer.pdf
'I’m not using the user name yet but in a future release I will use it to send an
'email with the file attached to the user
'The calendar URL below is captured from the URL that DWA generates to print a calendar
'If you don’t like the formatting that I selected go ahead into DWA for yourself
'and go to the print calendar dialog. Capture the URL that gets sent when you click
'the refresh preview button with the settings that you like and then replace the
‘value in the CalendarURL variable below.’
'Make sure to fill in the username and password below with an ID that has rights to
‘all the appropriate mailfiles’
InputFile = InputBox(“What is the file name of the input file”)
SET fso = CREATEOBJECT(“Scripting.FileSystemObject”)
SET fileMailInfo = FSO.OpenTextFile(InputFile, 1, false, -2)
'We need a username and password that has access to everyone’s mail files
‘Make sure that it is escaped properly for use in a URL’
UserName = “Joe%20Blow”
Password = “lotusnotes”
CalendarURL = “/iNotes/Proxy/?OpenDocument&UserName=” & UserName & “&Password=” & Password & “&Form=s_calPrint2&PresetFields=paperSize;0,styleType;2,sheetType;0,flags;0110,fontSize;1,langPref;en,acceptLang;en,startDate;20070311T125645Z,endDate;20070331T125645Z”
Protocol = “http://”
‘Open an DWA url to get all the cookies set appropriatly’
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const ForWriting = 2
Dim web, varByteArray, strData, strBuffer, lngCounter, ado, ts
Set web = Nothing
Set web = CreateObject(“WinHttp.WinHttpRequest.5.1”)
If web Is Nothing Then Set web = CreateObject(“WinHttp.WinHttpRequest”)
If web Is Nothing Then Set web = CreateObject(“MSXML2.ServerXMLHTTP”)
If web Is Nothing Then Set web = CreateObject(“Microsoft.XMLHTTP”)
Do until fileMailInfo.AtEndOfStream
strMailLine = fileMailInfo.ReadLine
MailArray = Split(strMailLine, ",",-1)
strServer = MailArray(0)
MailFilePath = MailArray(1)
MailUserName = MailArray(2)
strFile = MailArray(3)
strURL ="http://" & strServer & MailFilePath & CalendarURL
web.Open "GET", strURL, False
web.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
web.SetRequestHeader "host", "dmcamus10.soups.com"
web.SetRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*"
web.SetRequestHeader "Accept-Language", "en-us"
'The Shimmer cookie below is where the DSTLaw & timezone gets set. Look at the end and manipulate it appropriatly
‘Keep in mind if you have users in multiple timezones you may need to change it up for them’
web.SetRequestHeader "Cookie", "Shimmer=ui:I&SI_TLM:20070119T204435,25Z&V_TLM:20070119T204435,25Z&MOFolder:($Inbox)&MOFolderLabel:Inbox&PSLP:1&DNIDate:20070119&CalIDate:20070119&MOTLM:20070118T190843,83Z&AMActive:1&MOSortBy:4&NMTLP:20070119T205052Z&NMSeqNo:253687&CSDT:-809&CalView:F&ShimCPTZ:Z=5$DO=1$DL=4 1 1 10 -1 1$ZN=Eastern"
web.Send
varByteArray = web.ResponseBody
'Save the file
On Error Resume Next
Set ado = Nothing
Set ado = CreateObject("ADODB.Stream")
ado.Type = adTypeBinary
ado.Open
ado.Write varByteArray
ado.SaveToFile strFile, adSaveCreateOverWrite
ado.Close
Loop