SPSS Script from version 15 to version 20 in BASIC - vba

The below script is written in 'Winwrap basic' which is almost identical to VBA.
I would like this script to work on SPSS 20, the script works fine on SPSS15 (by changing the file extension from STT to TLO as that is what the tablelook file was back then).
However, whenever I run this script in SPSS 20 the wwb processor crashes with a generic error message 'WWBProcessor has encountered a problem and needs to close. We are sorry for the inconvenience.'
The script is well commented, but the purpose of the script is to change the tablelook of every table in the output viewer window, by activating each table in turn and setting the table look to one specified by the user, rotating the inner column labels, closing the table and activating the next table.
The loop continues until every table has been set to the new tablelook and rotation.
Manually setting the rotation of a few hundred tables is arduous and very time consuming not to mention numbingly boring. This script used to perform this task in seconds back in version 15, but ever evolving needs and lack of support for the older version has meant that I've been forced to use the newer version.
I'd be grateful for any assistance.
Mav
Option Explicit
Sub Main
'BEGIN DESCRIPTION
'This script changes all tabs to the same 'Tablelook' style. You will be prompted to choose the tablelook file.
'END DESCRIPTION
'******************
'Old description
'This script assumes that objSpssApp ist the currently running
'SPSS-Application and assigns every existing Pivot Table
'in the Output Navigator a new TableLook which can be selected
'from a Dialog box. Hidden tables will also be affected.
'Originally Created by SPSS Germany. Author: Arnd Winter.
'******************
'This script is written in the BASIC revision 'WinWrap Basic' code copied from VB or other basic languages may have to be modified to function properly.
On Error GoTo Bye
' Variable Declaration
' For an undertermined reason scripts cannot be executed throught the Utilites -> Run scripts menu,
' Instead they must be opened like a syntax file and ran from the SPSS 19 Scripting page.
' Functionality on SPSS 20 is now completely gone, error message only reads 'WWB processor has encountered a problem and needs to close'.
Dim objOutputDoc As ISpssOutputDoc 'Declares the Output variable
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc 'Assigns currently active output to Output variable
Dim strAppPath As String
Dim objOutputItems As ISpssItems 'variable defining every item in the current output window
Dim objOutputItem As ISpssItem 'variable defining the current item
Dim objPivotTable As PivotTable
Dim intCount As Integer 'declare the variable that will store the number of instances
Dim varStrLook As String
Set objOutputItems=objOutputDoc.Items
Dim i As Integer 'for loops we need an INT variable that will be counted against the number of instances 'i' is standard notation
' Find out SPSS Directory
strAppPath = objSpssApp.GetSPSSPath
' Select TableLook
'The Parametres you must enter into the GetFilePath() function are as follows:
'(Optional)Firstly you enter the initial file name (if none is required use an asterisk * and the file extention, or *.*)
'(Optional)The second part is the file extention expected, you can choose multiple filetypes if you seperate them with a semi-colon ;
'(Optional)The third parametre is the directory where the file should be opened.(default - Current path)
'The fourth parametre is the Title of the prompt, which should be enclosed in speech marks.
'The Final parametre is the 'Option'
'0 Only allow the user to select a file that exists.
'1 Confirm creation when the user selects a file that does not exist.
'2 Allow the user to select any file whether it exists or not.
'3 Confirm overwrite when the user selects a file that exists.
'+4 Selecting a different directory changes the application's current directory.
'For more detailed information visit the WWB website.
' http://www.winwrap.com/web/basic/language/?p=doc_getfilepath__func.htm
varStrLook = GetFilePath$("*.stt","stt",strAppPath,"Select Tablelook and confirm with Save.",4)
' Tested re-applying the dollar sign, cofusingly removing or adding the Dollar sign ($)
' seems to have no effect.
' If user presses Cancel or selected a file with the wrong file type then exit script
If (Len(varStrLook)= 0) Or (Right(varStrLook,3)<>"stt") Then
Exit Sub
End If
' Loop which assigns a new TableLook to all existing Tables.
intCount = objOutputItems.Count 'Assigns the total number of output items to the count-marker
For i = 0 To intCount-1 'Start loop
Set objOutputItem=objOutputItems.GetItem(i) 'Get current item
If objOutputItem.SPSSType=SPSSPivot Then 'If the item is a pivot table then...
Set objPivotTable=objOutputItem.ActivateTable 'Activate the table for editing
objPivotTable.TableLook = varStrLook 'Apply the earlier selected table look.
objPivotTable.RotateColumnLabels=True 'Rotate collumn lables
objOutputItem.Deactivate 'Confirm changes and deactivate the table
End If
Next 'End loop
'********************************************************
'Updated script from Version 15 ->
'Script now includes inner column label rotation
'Script has been modified and adapted to improve performance
'and to help people who wish to use/adapt the script
'in future endeavours.
'********************************************************
Bye:
End Sub

The first thing to try is to replace the activate/deactivate calls with
GetTableOLEObject
This is much more efficient and does not require the pivot table editor, but you can do all the things that you could do on an activated table.
If you don't have the current fixpack for V20, fixpack2, installing that would be a good idea, too.

Related

Is accessing the "IEEE new reference window" in Word with VBA possible?

With VBA, is it possible to open the window displayed when adding a new IEEE reference in Word (2013-2019), and access the fields' filled in values on closing it?
It's the window which asks for the publication type (book, journal...) and based on that presents different TextBoxes to be filled in (authors, title, publisher...)
Perhaps along these lines (i.e. not working code, just an outline):
' Declare some variables
Dim result As Long
Dim sourceCount As Long
Dim mySource As Source
' record the Source count pre-dialog
sourceCount = ActiveDocument.Bibliography.Sources.Count
' Set the Bibliographic Style to IEEE
ActiveDocument.Bibliography.BibliographyStyle = "IEEE"
' Display or Show the Create Source Dialog box
result = Dialogs(wdWordDialog.wdDialogCreateSource).Display
' .Show and .Display *should in theory * return different values
' depending on whther the user clicked OK, Cancel, the dialog's
' Close box etc.but on Windows Word the returned value
' always seems to be 0. On Mac Word that seems to work OK.
' So actually you might as well get rid of 'result' and use
' Dialogs(WdWordDialog.wdDialogCreateSource).Display
' so see if any new entries have been added
If ActiveDocument.Bibliography.Sources.Count > sourceCount Then
' There's a new entry. For the sake of argument, assume that the newest Source is the last in the list
Set mySource = ActiveDocument.Bibliography.Sources(ActiveDocument.Bibliography.Sources.Count)
' At this point, it probably helps to look at the XML of the new source, e.g.
Debug.Print mySource.XML
' Because the XML only contains the elements corresponding to the
' fields that the user filled in.
' Perhaps the Tag field is always present - I have not checked.
' You can try to retrieve the value of a particular field using e.g.
Dim author As String
author = mySource.Field("author")
' but if there is no author element in the XML, that will raise an error
; i.e. you'll probably need some On Error Resume Next handling.
' To use that approach you have to know the field names for every
' possible field in any type of IEEE source, and/or what fields are
' allowed in each type of source.
' Not sure the Word object model will help you there.
' **new material**
' All the possible field names and the corresponding XML
' element names are listed in a file called bibform.xml
' in the Microsoft Office program folder structure.
' On my Windows system, that's in
' C:\Program Files\Microsoft Office\root\Office16\1033\Bibliography
' On Mac, it's inside the app's package, e.g. the US English
' version is in
' Application/Microsoft Word/Contents/Resources/en.lproj
' There are different bibform.xml files for different
' (human) languages but the XML element names are the same
' for every language.
' So perhaps a better approach would be to parse the XML for
' the new Source and discover what fields are actually in there.
' I'm not going to try that here.
Set mySource = Nothing
End If
If it turns out that the most recently added Source is not always this one
ActiveDocument.Bibliography.Sources(ActiveDocument.Bibliography.Sources.Count)
then you might have to do something like
create a list of Sources prior to displaying the dialog box
display the dialog box
if there's a new Source, work out which one it is by comparing with the existing list
Without further testing, it's not even obvious that the new Source's Tag/Tag Name is unique.
Notes:
MacWord seems to work much the same way except as commented above.
ActiveDocument.Bibliography.BibliographyStyle = "IEEE" assumes you have
an unmodified Office/Word installation with the standard IEEE Style installed.

Word automation failing on server, but dev station works great

I am automating a oft-used paper form by querying the user on a web page, then modifying a base Word document and feeding that modified doc file to the user's browser for hand-off to Word.
The code is Visual Basic, and I am using the Microsoft.Office.Interop module to manipulate the document by manipulating Word. Works fine on the development system (Visual Studio 2015) but not on the production server (IIS 8.5).
Both the Documents.Open() call and the doc.SaveAs() call fail with Message="Command failed" Source="Microsoft Word" HResult=0x800A1066
Things I've tried:
Added debugging out the whazoo: Single-stepping is not an option on the production machine, so I pinpointed the problem lines with debug output.
Googled and found that this problem has been reported as early as 2007, but no viable solutions were reported.
A couple sites mentioned timing issues, so I added several pauses and retries -- none helped.
Some mentioned privileging, so I tried changing file permissions & application pool users -- neither helped.
Enhanced my exception handling reports to show more details and include all inner exceptions. That yielded the magic number 800A1066 which led to many more google hits, but no answers.
Added fall-back code: if you can't open the main document, create a simple one. That's when I found the SaveAs() call also failing.
Dropped back to the development system several times to confirm that yes, the code does still work properly in the right environment.
Greatly condensed sample code does not include fallback logic. My Word document has a number of fields whose names match the XML tokens passed as parameters into this function. saveFields() is an array of those names.
Dim oWord As Word.Application
Dim oDoc As Word.Document
oWord = CreateObject("Word.Application")
oWord.Visible = True
oDoc = oWord.Documents.Open(docName)
Dim ev As String
For i = 0 To saveFields.Length - 1
Try
ev = dataXD.Elements(saveFields(i))(0).Value
Catch
ev = Nothing
End Try
If ev IsNot Nothing Then
Try
Dim field = oDoc.FormFields(saveFields(i))
If field IsNot Nothing Then
If field.Type = Word.WdFieldType.wdFieldFormTextInput Then
field.Result = ev
End If
End If
Catch e As Exception
ErrorOut("Caught exception! " & e.Message)
End Try
End If
Next
...
oDoc.SaveAs2(localDir & filename)
oDoc.Close()
oWord.Quit(0, 0, 0)
The code should generate a modified form (fields filled in with data from the parameters); instead it fails to open, and the fallback code fails to save the new document.
On my dev system the document gets modified as it should, and if I break at the right place and change the right variable, the fallback code runs and generates the alternate document successfully -- but on the production server both paths fail with the same error.
Barring any better answers here, my next steps are to examine and use OpenXML and/or DocX, but making a few changes to the existing code is far preferable to picking a new tool and starting over from scratch.
Unfortunately, Lex Li was absolutely correct, and of course, the link to the reason why is posted on a site my company considers off limits, thus never showed up in my google searches prior to coding this out.
None of the tools I tried were able to handle the form I was trying to automate either -- I needed to fill in named fields and check/uncheck checkboxes, abilities which seemed beyond (or terribly convoluted in) the tools I evaluated ...
Eventually I dug into the document.xml format myself; I developed a function to modify the XML to check a named checkbox, and manipulated the raw document.xml to replace text fields with *-delimited token names. This reduced all of the necessary changes to simple string manipulation -- the rest was trivial.
The tool is 100% home-grown, not dependent upon any non-System libraries and works 100% for this particular form. It is not a generic solution by any stretch, and I suspect the document.xml file will need manual changes if and when the document is ever revised.
But for this particular problem -- it is a solution.
This was the closest I got to a complicated part. This function will check (but not uncheck) a named checkbox from a document.xml if the given condition is true.
Private Shared Function markCheckbox(xmlString As String, cbName As String, checkValue As Boolean) As String
markCheckbox = xmlString
If checkValue Then ' Checkbox needs to be checked, proceed
Dim pos As Integer = markCheckbox.IndexOf("<w:ffData><w:name w:val=""" & cbName & """/>")
If pos > -1 Then ' We have a checkbox
Dim endPos As Integer = markCheckbox.IndexOf("</w:ffData>", pos+1)
Dim cbEnd As Integer = markCheckbox.IndexOf("</w:checkBox>", pos+1)
If endPos > cbEnd AndAlso cbEnd > -1 Then ' Have found the appropriate w:ffData element (pos -> endPos) and the included insert point (cbEnd)
markCheckbox = markCheckbox.Substring(0, cbEnd) & "<w:checked/>" & markCheckbox.Substring(cbEnd)
End If
' Any other logic conditions, return the original XML string unmangled.
End If
End If
End Function

store word content in variable

How do I copy the entire content (approx 2 pages) of a Word document in VBA and store in a variable?
I keep trying several things, none of which works:
Dim mainData As String
ThisDocument.Activate
ActiveDocument.WholeStory 'error on this line
mainData = Selection.Text
With 'record macro' I can simulate selecting a piece or the entire text, but I can't simulate storing that into a variable.
The above code throws
'This command is not available because no document is open',
but hadn't I first activated this (the current) document, and then selected it (ActiveDocument.WholeStory)?
Why doesn't this work?
Later edit: I managed to do the selection like this:
Dim sText As String
Application.Selection.ClearFormatting
Application.Selection.WholeStory
sText = Application.Selection.Text
MsgBox sText
but the problem is I can't store the entire text (2 pages) in a variable. Part of it is truncated. Would you know how to store word by word (I only need a word at a time anyway)?
Later edit. I applied strReverse on the text to find out the text is actually stored entirely in the variable, just not fully displayed in the message box.
Don't use ThisDocument in code, unless you specifically want to address the file in which the code is stored and running. ThisDocument is the "code name" of that file.
Instead, use ActiveDocument to mean the document currently active in the Word window.
An addition, if you want the Selection in the currently active document, there's no reason to activate it - it's already active.
So to get the entire document content in a string
Dim mainData As String
mainData = ActiveDocument.Content.Text
where Content returns the entire main body's text as a Range object.
Note: The MsgBox has an upper character limit. If you're working with long text strings and want to see what they hold the following has more (but not "infinite") capacity:
Debug.Print mainData
All you need is:
Dim mainData As String
mainData = ActiveDocument.Range.Text

Office 365/Outlook 2016 Move a file with an attachment that contains a string to another folder

I receive multiple log files per day and would like to create a rule or vba script that will move the email to a specified folder. The catch is, it should only be moved if it contains specific text in an xml attachment. I'm new to VBA and couldn't find anything that look particularly helpful online, and I couldn't find a way to do it with a rule.
I am able to find the correct files to move if I do a manual search [ext:xml attachment:TestScriptFailed], but I'm not sure how to translate that into a rule or VBA script to automate the transfer process.
You have been a member for 26 months so you should be aware this site is for programmers to help each other develop. You have asked way too much in a single question and have made no obvious attempt to break it down. If someone gave you macro that was almost what you wanted, would you understand it enough to finish it? I will try to get you started.
I know nothing that suggests a rule exists that can test for a particular string within a particular type of attachment and, if found, save that attachment. I am not an experienced user of rules so this may be my ignorance. The SuperUser site would be a better place to ask about such a rule. I will suggest a macro. Start by running the macro manually every hour or once per day or whenever. There are more advanced techniques but let’s get the macro working before we worry about the most convenient way to run it.
First, look at this answer of mine: How to copy Outlook mail message into excel using VBA or Macros
We get a lot of questions along to lines: “I am trying to extract xxxx from emails and copy it to an Excel workbook”. This is accompanied by an image of the email. What the questioners seem unable to understand is that an image of the email tells us nothing about what the email’s body looks like to a VBA macro. Is it text or Html or both? If Html, is the formatting native or CSS? Does it use SPAN or DIV elements with class or id attributes to identify the different sections?
The referenced macro was an attempt to help questioners understand this issue. It creates a new Excel workbook and outputs to it the major properties of every email in Inbox.
There is nothing in your question to suggest you are interested in output to Excel but I think this is a good start for you. It reads down Inbox examining every email. It extracts subject and sender which might be interesting. It lists the type and name of every attachment which you will need. It outputs the text and Html bodies which might be interesting.
Download that macro, change the destination folder as instructed and run the macro. Search the workbook for one of your “log file” emails. Is the text within the Xml file the only indication that it is a log file email? This macro gives the structure you want (it reads down the Inbox) but contains lots of stuff of no interest to you. You can either delete the uninteresting bits from that macro or create a new macro by extracting the interesting bits. Can you do that? If you cannot, you will not be able to cope with the more advanced functionality necessary for a complete solution to your requirement.
I will have to update, the referenced answer. I have recently upgraded to Outlook 2016 and have found an issue. My installation does not use the default Inbox which the macro searches so the macro would create an empty workbook. Outlook 2016 has created a “store” per email address with names of the form: abcdefghi#isp.com. In the folder pane, these are the top names in each hierarchy. Each of these stores contains its own Inbox which is where new emails sent to the relevant address are stored. If your installation is like mine, you will have to replace:
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
by
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").Folders("abcdefghi#isp.com").Folders("Inbox")
Once you have the structure of your macro, the next problem is to identify the emails with an Xml attachment that contains the identifying text. You cannot look at an email’s attachment directly. You have to save them to disc and process them there. With VBA you can open an Xml file as a text file and scan for the identifying text. If I understand correctly, it is Xml files containing the identifying text you require. If so, if an Xml contains the identifying text, it is left on disc otherwise it is deleted. If the Xml file is retained, you need to move the email to another folder so it will not be examined again.
I have: (1) saved attachments to disc, (2) moved emails from one folder to another and (3) processed text files with VBA, although never from Outlook, but never in one macro. I will treat this as a training exercise for myself and develop the code you need to drop into the macro I have told you to develop.
Possible issue 1: How big are these log files? There seem to be a limit of around 15Mb for emails. VBA can easily process files of 15Mb but you do not want to load an entire file of this size into memory if the identifying text is in the first 1,000 bytes.
Possible issue 2: Do the log files have unique names? If they have unique names, they can be saved under those names. If they do not have unique names, unique names will have to be generated for them. A unique name could be as simple as “LFnnnn.Xml” where “nnnn” is one more than the number of the previous log file. Alternatively, it could be as complex as you want.
Update
Rereading your question, I believe if I may have misinterpreted your requirement. I read that you wanted the log file attachments moved to a disc folder. I believe niton read it the same way. I now believe you want the mail item moved to a new Outlook folder and do not specify what is to happen to the log file attachment. I do not think this misinterpretation is important or makes a material difference to the required macro. An email containing a log file has to be moved to a new Outlook because otherwise it would be processed again and again. A log file has to be extracted to a disc folder so that its contents can be checked. My code leaves an Xml file containing the identifying text on disc. One additional statement would delete such an Xml file just as those Xml files that do not contain the identifying text are deleted. I assume the log files have to be extracted sometime. Perhaps you did not appreciate that they would have to be extracted to meet your requirement. I leave you to decide whether or not to add that Kill statement.
I said the default Inbox may not be the Inbox into which these emails are loaded. I have created a little macro that outputs the user name of the store containing the default Inbox which you may find helpful:
Sub DsplUsernameOfDefaultStore()
Dim NS As Outlook.NameSpace
Dim DefaultInboxFldr As MAPIFolder
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)
Debug.Print DefaultInboxFldr.Parent.Name
End Sub
The following macro does all the heavy lifting for your requirement:
Public Sub SaveInterestingAttachment(ByRef ItemCrnt As MailItem, _
ByVal IdentExtn As String, _
ByVal IdentText As String, _
ByVal DestDiscFldr As String, _
ByRef DestOlkFldr As MAPIFolder)
' * ItemCrnt may contain one or more attachments which have extension
' IdentExtn and which contains text IdentText. If it contains such
' attachment(s) then the macro:
' * saves all such attachments to disc folder DestDiscFldr
' * moves the mail item to output folder DestOlkFldr.
' * Comparisons of IdentExtn and IdentText against file extensions and
' contents are case insensitive because the strings are converted to
' lower case before comparisons.
' * The phrase "saves all such attachments" is perhaps slightly
' misleading. An attachment can only be checked to contain the
' identifying text by saving it to disc, opening it and scanning the
' contents. So all attachments with extension IdentExtn are saved to
' disc and those that do not contain IdentText are deleted.
' Warning: This code assumes DestDiscFldr has a trailing \
' Warning: This code does not test for an existing file with the same name
' Warning: To compile, this macro needs a Reference to "Microsoft Scripting
' RunTime". Click Tools then References. Click box against
' "Microsoft Scripting RunTime" if not already ticked. The Reference
' will be at the top if ticked. Unticked references are in
' alphabetic sequence.
Const ForReading As Long = 1
Const OpenAsAscii As Long = 0
Dim FileContents As String
Dim FileXml As TextStream
Dim Fso As FileSystemObject
Dim InxA As Long
Dim LcExtn As String: LcExtn = LCase(IdentExtn)
Dim LenExtn As Long: LenExtn = Len(IdentExtn)
Dim LcIdText As String: LcIdText = LCase(IdentText)
Dim MoveEmail As Boolean
Dim PathFileName As String
With ItemCrnt
If .Attachments.Count > 0 Then
Set Fso = CreateObject("Scripting.FileSystemObject")
MoveEmail = False
For InxA = 1 To .Attachments.Count
If Right$(LCase(.Attachments(InxA).FileName), 1 + LenExtn) = _
"." & LcExtn Then
' My test files do not have unique names. Adding received time and
' subject was an easy way of making the names unique and demonstrates
' some options.
PathFileName = DestDiscFldr & Format(.ReceivedTime, "yymmddhhmmss") & _
" " & .Subject & " " & _
.Attachments(InxA).FileName
.Attachments(InxA).SaveAsFile PathFileName
Set FileXml = Fso.OpenTextFile(PathFileName, ForReading, OpenAsAscii)
FileContents = FileXml.ReadAll
' If your log files are large snd the identifying text is near
' the beginning, Read(N) would read the first N characters
If InStr(1, LCase(FileContents), LcIdText) <> 0 Then
' Xml file contains identifiying text
' Leave Xml on disc. Move email to save folder
MoveEmail = True
FileXml.Close
Else
' Delete Xml file. Leave email in Inbox unless another attachment
' contained the identifying text
FileXml.Close
Kill PathFileName
End If
Set FileXml = Nothing
End If
Next
If MoveEmail Then
.Move DestOlkFldr
End If
Set Fso = Nothing
End If
End With
End Sub
This macro has five parameters:
A reference to the Mail Item to be tested.
The value of the extension to be tested.
The value of the identifying text.
The value of the disc folder to which attachments are to be saved.
A reference to the Outlook folder to which appropriate Mail Items are to be moved.
I am very confident that eventually this code will have to be called from two different parent macros so making the Mail Item a parameter was necessary. The other parameters could have been hard coded into the macro but making them parameters was no extra effort and parameters are usually easier to explain that values buried in the body of a macro.
You need to work down this macro reading the comments and reviewing the statements. My test data is based on my understanding of your requirement. If I have misunderstood and my test data is faulty, this macro may fail with your data. You will need to carefully check the code and then carefully test it with your data.
I needed a test harness to test this macro since a macro with parameters cannot be called by the user. If you have created a macro to read down the Inbox, it will be very similar to my test harness. My test harness reads down the Inbox and calls SaveInterestingAttachment for each Mail Item.
Even more than SaveInterestingAttachment, this macro must be carefully checked and updated. This macro references folders on my disc and folders within my Outlook installation. These references will have to be updated.
Sub TestSaveInterestingAttachment()
' For every mail item in Inbox, call SaveInterestingAttachment.
Dim DestOlkFldr As MAPIFolder
Dim SrcOlkFldr As MAPIFolder
Dim InxItemCrnt As Long
Dim NS As Outlook.NameSpace
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
' You only need one of the next two Set statements. If your Inbox is not
' Outlook's default then amend the second to reference your default Inbox.
' This is the easiest way to reference the default Inbox.
' However, you must be careful if, like me, you have multiple email addresses
' each with their own Inbox. The default Inbox may not be where you think it is.
Set SrcOlkFldr = NS.GetDefaultFolder(olFolderInbox)
' This references the Inbox in a specific PST or OST file.
' "abcdefghi#MyIsp.com" is the user name that Outlook gave the PST file in
' which it stores emails sent to this account when I created the account. The user
' name is the name Output displays to the user. The file name on disk is different.
Set SrcOlkFldr = NS.Folders("abcdefghi#MyIsp.com").Folders("Inbox")
' I do not know where you want to save processed emails.
' In this description, a "store" is a file on disc in which Outlook stores
' your mail items, calendar items, tasks and so on. When you look at the
' folder pane, names against the left edge are the user names of stores.
' Indented names are folders within a store. The name of the file on disc
' is probably the same as the user name but with an extension of PST or OST.
' The first Set statement below shows how to reference a folder at the same
' level as Inbox in the same store. It does this by using property Parent to
' go up one level and then property Folders to go down one level.
' The second Set statement below shows how to reference a sub-folder of
' Inbox. It does this by using property Folders to go down one level.
' The third Set statement below shows how tp reference a folder "Processed2"
' within folder "Inbox" within store "outlook data file".
' None of these Set statements will meet your requirements. Use these
' examples to build a Set statement suitable for your requirements.
Set DestOlkFldr = SrcOlkFldr.Parent.Folders("!Tony")
Set DestOlkFldr = SrcOlkFldr.Folders("Processed3")
Set DestOlkFldr = NS.Folders("outlook data file").Folders("Inbox").Folders("Processed2")
' This examines the emails in reverse order.
' If I process email number 5 and then move it to another folder,
' the number of all subsequence emails is decreased by 1. If I looked at the
' emails in ascending sequence, email 6 would be ignored because it would have
' been renumbered when I looked for it. By looking at the emails in reverse
' sequence, I ensure email 6 has bee processed before the removal of email 5
' changes its number.
With SrcOlkFldr.Items
For InxItemCrnt = .Count To 1 Step -1
If .Item(InxItemCrnt).Class = olMail Then
' I am only interested in mail items.
' You will need to replace the identying text and the
' destination disc folder
Call SaveInterestingAttachment(.Item(InxItemCrnt), "Xml", _
"identifying text", _
"C:\DataArea\SO\", DestOlkFldr)
End If ' .Class = olMail
Next InxItemCrnt
End With
End Sub
I have attempted a second test harness. I have recently upgraded to Outlook 2016 and this is the first time I have attempted to use events with it. Code which worked perfectly with my previous version no longer works. There are a number of possible reasons for this code not working. Until I have identified the cause, I will give no further information about this second test harness.
Update 2
I have now fixed the problem with my second test harness. A statement that worked with Outlook 2003, which I was still using until a couple of months ago, apparently does not work with Outlook 2016.
You will need a routine based on my first test harness because that routine searches Inbox for log file emails that have already arrived. I also believe it is an easier routine for testing SaveInterestingAttachment until you have updated it to your exact requirements.
The second test harness sits in the background monitoring new emails and processing those containing log files.
I have a home installation and emails register as new when they are downloaded from my ISP’s server to my hard drive. An email can only be downloaded while I have Outlook open. Once I have run test harness 1 to clear my Inbox of previously received log file emails, I can rely on test harness 2 to handle any future log file emails.
If you have an office installation, then your emails may register as new when they reach your organisation’s server. If that is the case, you will always need a routine based on test harness 1 to handle those log file emails that arrive overnight or whenever you do not have Outlook open.
From within Outlook’s Visual Basic Editor, look as the Project Explorer pane. On my installation, the top line is “Project1 (VbaProject.OTM)”. On your installation, the top line might be slightly different.
If there is a “+” to the left of “Project1 (VbaProject.OTM)”, click that “+” to display the items under “Project1 (VbaProject.OTM)”. On my installation these are: “Microsoft Outlook Objects”, “Forms” and “Modules”. You will not have any forms.
If there is a “+” to the left of “Microsoft Outlook Objects”, click that “+” to display the items under “Microsoft Outlook Objects”. The only item displayed will be “ThisOutlookSession”.
Click “ThisOutlookSession” and the code area will become blank. This is a special code area. Previously you will have created modules which are suitable for storing general routines. The code below will only work if it is within “ThisOutlookSession”.
As before, this code will have to be amended to match your Outlook installation and your disc layout. The full code is at the bottom but I introduce it bit by bit to help you understand what it is doing.
My code contains:
Option Explicit
Two variables that can be accessed by either of the subroutines.
Subroutine Application_Startup()
Subroutine InboxItems_ItemAdd(ByVal Item As Object)
You should have Option Explicit at the top of every module. Look it up if you do not know why.
Subroutine Application_Startup() will be executed every time you open Outlook. With this routine in place, you will be warned about “ThisOutlookSession” before Outlook opens. You need to enable macros if Application_Startup() is to be executed.
I suggest you start by copying the following:
Private Sub Application_Startup()
' This event routine is called when Outlook is started
Dim UserName As String
With Session
UserName = .CurrentUser
End With
MsgBox "Welcome " & UserName
End Sub
Having copied this code to "ThisOutlookSession", close Outlook and save your VBA project. Reopen Outlook, enable macros and you will see a message box saying "Welcome Stephanie". This serves no useful purpose but ensures we have the envelope correct before we do anything important.
Copy: Private WithEvents InboxItems As Items. Study the statement starting Set InboxItems = and the comments above it. You will need to construct a version of this statement appropriate for your Inbox. This Set statement makes InBoxItems reference to the Inbox. To confirm, go to the end of the macro where you will find:
Debug.Print InboxItems.Count
If InboxItems.Count > 0 Then
With InboxItems.Item(1)
Debug.Print .ReceivedTime & " " & .Subject & " " & .SenderEmailAddress
End With
End If
These statements output the number of items in the Inbox and details of the first email which is almost certainly the oldest email. Once you have copied these statements, close Outlook, save the VBA project and then open Outlook again. If all is as it should be, the Immediate Window will contain a count and details of an email. If it is not, we need to identify the cause and correct it before continuing.
Copy: Private DestOlkFldr As MAPIFolder. Study the statement starting Set DestOlkFldr = and the comments above it. You will need to construct a version of this statement appropriate for your destination Outlook folder. Again go to the end of the macro where you will find:
Debug.Print DestOlkFldr.Name
Debug.Print DestOlkFldr.Parent.Name
Debug.Print DestOlkFldr.Parent.Parent.Name
On my system these display:
Processed2
Inbox
Outlook Data File
Copy or create as many Debug.Print statements as appropriate for how deeply nested your destination Outlook folder is. Close Outlook, save the VBA project and then open Outlook again. Are the correct names displayed? If so, Sub Application_Startup() is correct. Delete the diagnostic statements which are no longer required.
We are now ready to create Sub InboxItems_ItemAdd(ByVal Item As Object). I would start with:
Private Sub InboxItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is MailItem Then
With Item
Debug.Print "Mail item received at " & .ReceivedTime & " from " & _
.SenderEmailAddress & "(" & .Sender & ")"
End With
End If
End Sub
Close Outlook, save the VBA project, open Outlook again and wait for some emails to arrive. If necessary, send yourself an email. Details of those emails should be in the Immediate Window.
Finally, update and copy this statement:
Call SaveInterestingAttachment(Item, "Xml", _
"identifying text", _
"C:\DataArea\SO\", DestOlkFldr)
Close Outlook, save the VBA project, open Outlook again and wait for some log file emails to arrive. Are they being processed correctly?
Finally, a recap:
Application_Startup() is a reserved name. A subroutine with this name will be executed automatically when Outlook is opened. This is an example of an event routine. Event routines are executed when the appropriate event occurs. I have included the code in Application_Startup()necessary to prepare for the new email arrived event.
InboxItems_ItemAdd(ByVal Item As Object) is the reserved name and mandatory specification for the Add item to InboxItems (that is new email arrived) event routine. InboxItems was the WithEvents variable we declared at the top and initialised with Application_Startup().
If you are not used to thinking about computer events and what you want to happen when they occur, they can be a little tricky to understand although once you do, you will have difficulty remembering what the problem was. I have introduced them in tiny steps. This is how I try out new functionality. If necessary, sleep on it. Trust me, suddenly it will all make sense.
Come back with questions as necessary but the more you can understand on your own, the faster you will develop.
Option Explicit
Private WithEvents InboxItems As Items
Private DestOlkFldr As MAPIFolder
Private Sub Application_Startup()
' This event routine is called when Outlook is started
Dim UserName As String
With Session
' In TestSaveInterestingAttachment() you have a statement like:
' Set SrcOlkFldr = NS.GetDefaultFolder(olFolderInbox)
' or Set SrcOlkFldr = NS.Folders("abcdefghi#Isp.com").Folders("Inbox")
' You need a similar statement here without the "NS" at the beginning
' and with ".Items" at the end. For example:
'Set InboxItems = .GetDefaultFolder(olFolderInbox).Items
Set InboxItems = .Folders("abcdefghi#Isp.com").Folders("Inbox").Items
' In TestSaveInterestingAttachment() you have a statement like:
' Set DestOlkFldr = SrcOlkFldr.Parent.Folders("!Tony")
' or Set DestOlkFldr = SrcOlkFldr.Folders("Processed3")
' or Set DestOlkFldr = NS.Folders("outlook data file").Folders("Inbox").Folders("Processed2")
' There is no equivalent of SrcOlkFldr here so you cannot use the first two formats
' as a basis for the statement here. You must use the third format, without the
' leading NS, at the basis for the statement here. For example:
Set DestOlkFldr = .Folders("outlook data file").Folders("Inbox").Folders("Processed2")
UserName = .CurrentUser
End With
MsgBox "Welcome " & UserName
Debug.Print InboxItems.Count
If InboxItems.Count > 0 Then
With InboxItems.Item(1)
Debug.Print .ReceivedTime & " " & .Subject & " " & .SenderEmailAddress
End With
End If
Debug.Print DestOlkFldr.Name
Debug.Print DestOlkFldr.Parent.Name
Debug.Print DestOlkFldr.Parent.Parent.Name
End Sub
Private Sub InboxItems_ItemAdd(ByVal Item As Object)
' This event routine is called each time an item is added to Inbox because of:
' "Private WithEvents InboxItems As Items" at the top of this ThisOutlookSession
' and
' "Set InboxItems = Session.GetDefaultFolder(olFolderInbox).Items"
' or "Set InboxItems = Session.Folders("abcdefghi#Isp ").Folders("Inbox").Items"
' within "Private Sub Application_Startup()"
If TypeOf Item Is MailItem Then
With Item
Debug.Print "Mail item received at " & .ReceivedTime & " from " & _
.SenderEmailAddress & "(" & .Sender & ")"
End With
' You will need to replace the identying text and the
' destination disc folder
Call SaveInterestingAttachment(Item, "Xml", _
"identifying text", _
"C:\DataArea\SO\", DestOlkFldr)
End If
End Sub

Issue with pdf docs not showing up

We recently wrote some code for a client using the Aspose.pdf library, on my system the pdf in question opened fine and most of the merge fields were filled in (we don't have the exact list of merge fields that they do).
They're telling me that on their system, some documents take 2-4 mins to open while others don't open at all.
What could be a possible cause of the document not opening at all?
My code is below:
' Load form
Dim doc As Aspose.Pdf.Document = New Aspose.Pdf.Document(sTemplateDir & sDocName)
'Get names of form fields
Dim fields As Aspose.Pdf.InteractiveFeatures.Forms.Field() = doc.Form.Fields
Dim sField As String
Dim field As Aspose.Pdf.InteractiveFeatures.Forms.Field
If fields.Length > 0 Then
For Each field In fields
'Get name of field
sField = field.FullName
'If the merge field isn't valid then we'll just leave it and assume its a fill-in
If nMergeCol.Contains(sField) And Not IsNothing(sField) Then
field.Value = nMergeCol.Item(sField)
End If
Next
End If
This has been resolved! As we suspected, it was a problem with the client's Javascript within the pdf file. The problem was within the calculations the absolute value was being used (name.value). Once this was switched to the relative value (this.event.value) the pdf file began behaving correctly with the AsPose code.