Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Converting VBA to VBScript. Help! Don't know where else to go.

Status
Not open for further replies.
rexican

rexican

IS-IT--Management
Jan 27, 2011
3
CA
I'm trying to convert/re-write this VBA code into VBScript.
I'm getting no where. I don't know where else to look. I"m not a expert scripter... just a newbie.

THis script converts/re-creates an outlook form into an html file.
any help would be greatly appreciated.

Thanks.

Dim iBasePixel
Dim iTempPixel

Sub PrintForm()
Dim OL As Outlook.Application
Dim oldPages As Outlook.Pages
Dim oldProp As Outlook.UserProperty
Dim oldForm As Object
Dim oldControl As Control

Set OL = New Outlook.Application
Set oldForm = OL.ActiveInspector.CurrentItem
Set oldPages = oldForm.GetInspector.ModifiedFormPages

strFile = Environ("USERPROFILE") & "\Desktop\Form.HTML"
Open strFile For Output As #1

Print #1, "<HTML><HEAD></HEAD><BODY>"
iBasePixel = 0
iTempPixel = 0

For i = 1 To oldPages.Count
Set oldPage = oldPages.Item(i)
AddPageBreak oldPage.Name
For Each oldControl In oldPage.Controls
ProcessControl oldControl, oldForm, oldPage.Name
Next
Next
Print #1, "</BODY></HTML>"
Close #1
Call PrintFormInIE(strFile)
End Sub

Sub ProcessControl(oldControl, oldForm, strParentName)
'todo: Change oldPage to strParentName
If oldControl.Parent.Name = strParentName Then
strValue = ""
sProgID = GetProgID(oldControl)
Debug.Print sProgID
Select Case sProgID
Case "Forms.CheckBox.1"
If oldControl.Value = True Then
strValue = "<INPUT TYPE=Checkbox checked>"
Else
strValue = "<INPUT TYPE=Checkbox>"
End If
strValue = strValue & oldControl.Caption
PrintToHTML strValue, oldControl
Case "Forms.OptionButton.1"
If oldControl.Value = True Then
strValue = "<INPUT TYPE=Radio Checked>"
Else
strValue = "<INPUT TYPE=Radio>"
End If
' Only add the caption of the control is larger than 16 since controls
' smaller than 16 do not show text on Outlook forms (caption is hidden).
If oldControl.Width > 16 Then strValue = strValue & oldControl.Caption
PrintToHTML strValue, oldControl
Case "Forms.Label.1"
strValue = oldControl.Caption
PrintToHTML strValue, oldControl
Case "Forms.ComboBox.1"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldControl.Value & Chr(34)
strValue = AppendStyle(strValue, oldControl)
PrintToHTML strValue, oldControl
Case "Forms.TextBox.1"
ctlValue = oldControl.Value
If InStr(1, ctlValue, vbCr) Then
strValue = "<textarea "
strValue = AppendStyle(strValue, oldControl) & ctlValue & "</textarea>"
Else
strValue = "<INPUT TYPE=text value=" & Chr(34) & ctlValue & Chr(34)
strValue = AppendStyle(strValue, oldControl)
End If
PrintToHTML strValue, oldControl
Case "RecipientControl"
Select Case oldControl.Name
Case "Email"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldForm.Email1Address & Chr(34)
Case "WebPage"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldForm.WebPage & Chr(34)
Case "_RecipientControl1"
strLinks = ""
For Each oLink In oldForm.Links
strLinks = strLinks & oLink.Name & ";"
Next
strValue = "<INPUT TYPE=text Value=" & Chr(34) & strLinks & Chr(34)
Case "IMAddress"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldForm.IMAddress & Chr(34)
Case "To"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldForm.To & Chr(34)
Case "CC"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldForm.CC & Chr(34)
Case "Bcc"
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldForm.BCC & Chr(34)
Case Else
strValue = "<INPUT TYPE=text Value=" & Chr(34) & oldControl.Value & Chr(34)
End Select
If strValue <> "" Then strValue = AppendStyle(strValue, oldControl)
PrintToHTML strValue, oldControl
Case "DocSiteControl"
strValue = "<textarea "
strValue = AppendStyle(strValue, oldControl) & oldForm.Body & "</textarea>"
PrintToHTML strValue, oldControl
Case "Forms.CommandButton.1"
strValue = "<INPUT TYPE=button "
strValue = strValue & "Value=" & Chr(34) & oldControl.Caption & Chr(34)
strValue = AppendStyle(strValue, oldControl)
PrintToHTML strValue, oldControl
Case "Forms.Frame.1"
strBorder = ""
If oldControl.BorderStyle = 1 Then strBorder = "border-style: solid; border-width: 1px;"
strValue = "<fieldset style=""width: " & oldControl.Width & "; height: " & oldControl.Height & "; " & strBorder & " padding-left: 4px; padding-right: 4px; padding-top: 1px; padding-bottom: 1px"">"
strValue = strValue & "<legend>" & oldControl.Caption & "</legend>"
PrintToHTML strValue, oldControl

For Each oSubControl In oldControl.Controls
ProcessControl oSubControl, oldForm, oldControl.Name
Next

Print #1, "</fieldset>"
Case "Forms.Image.1"
strValue = ""
PrintToHTML strValue, oldControl
Case "Forms.MultiPage.1"
'strValue = Trim(Chr(34) & oldControl.Caption & " " & oldControl.Value & Chr(34))
strValue = Chr(34) & "MP1" & Chr(34)
PrintToHTML strValue, oldControl
Case Else
strValue = Trim(Chr(34) & oldControl.Caption & " " & oldControl.Value & Chr(34))
PrintToHTML strValue, oldControl
End Select

End If
End Sub


Sub PrintToHTML(strValue, oldControl)
If strValue <> "" Then
strValue = "<FONT SIZE=" & Chr(34) & 1 & Chr(34) & ">" & strValue & "</FONT>"
If TypeName(oldControl.Parent) = "UserForm" Then
intTop = oldControl.Top
PrintHTML strValue, intTop, oldControl.Left, oldControl.Height
Else
intTop = oldControl.Top + oldControl.Parent.Top
PrintHTML strValue, intTop, oldControl.Left + oldControl.Parent.Left, oldControl.Height
End If
End If
End Sub

Function AppendStyle(sValue, oControl) As String
On Error Resume Next
iWidth = oControl.Width
iHeight = oControl.Height
iFontSize = oControl.FONTSIZE
If iFontSize = "" Then iFontSize = 10


sValue = sValue & "style=" & Chr(34)
sValue = sValue & "width: " & iWidth & ";"
sValue = sValue & "height: " & iHeight & ";"
sValue = sValue & "font-size:" & iFontSize & ";"
sValue = sValue & Chr(34) & ">"
AppendStyle = sValue
End Function

Sub AddPageBreak(strname)
iBasePixel = (iBasePixel + iTempPixel + 25)

' iBorderLen = 60
' iBorderLen = iBorderLen - Len(strName)
' iBorderLen = Int(iBorderLen / 2)
' strBorder = String(iBorderLen, "=")
' strHTML = "<B>" & strName & "</B>"
' strHTML = strBorder & strHTML & strBorder
' PrintHTML strHTML, 5, 0, 0
PrintHTML "<B>" & strname & "</B>", 5, 0, 0
iBasePixel = iBasePixel + 25
iTempPixel = 0
End Sub

Sub PrintHTML(Value, iTop, iLeft, iHeight)
If iTop + iHeight > iTempPixel Then iTempPixel = iTop + iHeight

'Value = Replace(Value, vbCr, "<BR>")

strHTML = "<SPAN STYLE=" & Chr(34)
strHTML = strHTML & "position: absolute; "
strHTML = strHTML & "top: " & iTop + iBasePixel & ";"
strHTML = strHTML & "left: " & iLeft & ";"
strHTML = strHTML & Chr(34) & ">"
'strHTML = strHTML & "<FONT SIZE=" & Chr(34) & 1 & Chr(34) & ">"
strHTML = strHTML & Value
'strHTML = strHTML & "</FONT>"
strHTML = strHTML & "</SPAN>"
Print #1, strHTML
End Sub

Function GetProgID(oldControl) As String
sType = TypeName(oldControl.Object)
Select Case sType
Case "IMdcCheckBox"
sProgID = "Forms.CheckBox.1"
Case "ILabelControl"
sProgID = "Forms.Label.1"
Case "IMdcText"
sProgID = "Forms.TextBox.1"
Case "IMdcCombo"
sProgID = "Forms.ComboBox.1"
Case "IMdcList"
sProgID = "Forms.ListBox.1"
Case "IMdcOptionButton"
sProgID = "Forms.OptionButton.1"
Case "IMdcToggleButton"
sProgID = "Forms.ToggleButton.1"
Case "ICommandButton"
sProgID = "Forms.CommandButton.1"
Case "IMultiPage"
sProgID = "Forms.MultiPage.1"
Case "UserForm"
sProgID = "Forms.Frame.1"
Case "IImage"
sProgID = "Forms.Image.1"
Case "RecipientControl"
sProgID = sType
Case "DocSiteControl"
sProgID = sType
Case Else
Debug.Print sType
sProgID = "Forms.TextBox.1"
End Select
GetProgID = sProgID
End Function

'======================================================================
'======================================================================
'======================================================================

Sub AddControl(oldControl As Control)
sProgID = GetProgID(oldControl)
On Error Resume Next
With newControl
.Top = oldControl.Top
.Left = oldControl.Left
.Width = oldControl.Width
.Height = oldControl.Height
.TabIndex = oldControl.TabIndex
.TabStop = oldControl.TabStop
.Tag = oldControl.Tag
.Caption = oldControl.Caption
.Text = oldControl.Text
.Value = oldControl.Value
.ItemProperty = oldControl.ItemProperty
.Font = oldControl.Font
.Font.Bold = oldControl.Font.Bold
.ForeColor = oldControl.ForeColor
.BackColor = oldControl.BackColor
End With

Select Case sProgID
Case "Forms.MultiPage.1"
HandleMultipageControls oldControl, newControl
Case "Forms.Frame.1"
AddChildControls oldControl, newControl
Case Else
End Select
End Sub

Sub AddChildControls(oldControl, newControl)
Dim childControl As Control
For Each childControl In oldControl.Controls
If childControl.Parent.Name = newControl.Name Then
AddControl childControl ', newControl.Controls
End If
Next
End Sub

Sub HandleMultipageControls(oldMultiPage, newMultiPage)
newMultiPage.Pages.Clear
For Each oldPage In oldMultiPage.Pages
Set newPage = newMultiPage.Pages.Add(oldPage.Name)
AddChildControls oldPage, newPage
Next
End Sub

Sub PrintFormInIE(strURL)
Dim IE
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate strURL
Do Until IE.ReadyState = 4: WScript.Sleep 50: Loop
IE.ExecWB 6, 2
End Sub



GetFileName(strFile) Open strFile For Input As #1

 
Sort by date Sort by votes
Let's start here:

>I'm trying to convert/re-write this VBA code into VBScript

Why? And what precisely are you trying to achieve? There may be an easier approach ...
 
Upvote 0 Downvote
Ok... let me start from the begining.

I've created an outlook form for my company. For some reason, unknown to many, you cant print the form as it appears. It will only print out the field names in no particular order.

Within the forms, you can add code to enhance its functions.
unfortunatly, you can only use VBScript. Now i dont have anything against vbscripting, its just that its very difficult to find the write code.

What i found that was the only options were:

1. write code to export/transfer to Word.
- table must be pre-created before hand and every user needs access to the template file.

2. Export to excel/ same issue as the word option

3. Export to an html file. With this code, i automatically creates the html file, pre configures it with all the fields that the form has and automatically print it out. its a great option.

Problem - i'm very very new to vbscripting.. so i'm tryint to copy/modify other script to do what i need it to do. However, with this one, its much to complicated for me to understand.

 
Upvote 0 Downvote
>For some reason, unknown to many, you cant print the form as it appears

It's a known limitation of Outlook forms - basically, they are designed to only print out the text section. And yes, it is annoying.

So annoying that Microsoft added a control (and add-in) to the Office 2000 Resource Kit called XPrint that allows you to print out more-or-less what you like from a custom form (within reason). It isn't always an absolutely perfect WYSIWYG output, but it pretty close. The control works with Outlook 2000, 2003, 2007 and (I believe though have not tested) 2010

You can find it for download here. The installation includes a help file. But, assuming you have a "Print Me" command button on your form, the script to get basic fucntionality working is as simple as:
Code: 
[blue]Sub CommandButton1_Click()
   Dim objPage
   Dim objControls
   Dim objXPrint
   
   Set objPage = Item.GetInspector.ModifiedFormPages("Message")
   Set objXPrint = objPage.XPrint1
   Set objControls = objPage.Controls
   ' Let XPrint know what it is to print
   Set objXPrint.Controls = objControls
   ' Display the XPrint dialog box
   objXPrint.PrintForm
   Set objPage = Nothing
   Set objControls= Nothing
   Set objXPrint = Nothing
End Sub[/blue]
 
Upvote 0 Downvote
Thanks very much for your time. I really appreciate it.

Xprint was the first solution that i considered, however,I didn't want to manually install this on everyone computer. I dont want to add an extra step for local IT folks. This form would be used in about 4 locations in Ontario. If there was a way for me to add some code within the for stating that...
check if add-in is installed if not, then install.
if installed, then continue...

something along those lines. Of course i would have to place the add-in install on a shared drive that everyone has access to.

Is that possible?
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Alexvb6
  • Locked
  • Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
370
Alexvb6
Alexvb6
bdwilcox
  • Locked
  • Question
Trying to adapt VBScript to search if machine is in an AD group 6
Replies
8
Views
1K
SoftwareRT
SoftwareRT
K
  • Locked
  • Question
VBSCRIPT dont work windows 11 23h2 ???
Replies
2
Views
512
SoftwareRT
SoftwareRT
paullem
  • Locked
  • Question
vbscript to read properties of JPEG file
Replies
4
Views
445
paullem
paullem
Katto
  • Locked
  • Question
Excel VBA functions in VBScript
Replies
4
Views
313
dhookom
dhookom

Part and Inventory Search

Sponsor

Back
Top