PDA

View Full Version : Solved: Excel to Outlook - late binding?



tca_VB
08-14-2008, 11:20 AM
I've created an excel file that automates many excel functions via buttons and hidden from the reader. The last sheet allows the user to click a button to populate Outlook with either tasks or an email. I have tried the following code, but I'm having trouble with version levels of excel. I've received alot of help months ago to get it going - so I'm reiterating code received from others in some areas.

This Workbook - set VBA Trusted and Reference Libraries



Private Sub Workbook_Open()
IsVBATrusted
AddReference
End Sub
Function IsVBATrusted() As Boolean
Dim oVBC As Object
Application.DisplayAlerts = False
On Error Resume Next
Set oVBC = ThisWorkbook.VBProject.VBComponents.Item(1)
On Error GoTo 0
Application.DisplayAlerts = True
IsVBATrusted = Not oVBC Is Nothing
End Function
Sub AddReference()
'Macro purpose: To add a reference to the project using the GUID for the
'reference library

Dim strGUID As String, theRef As Variant, i As Long
Dim strGUIDb As String, strGUIDc As String, strGUIDd As String
Dim strGUIDe As String, strGUIDf As String, strGUIDg As String
Dim strGUIDh As String

'Update the GUID you need below.
strGUID = "{000204EF-0000-0000-C000-000000000046}"
strGUIDb = "{00020813-0000-0000-C000-000000000046}"
strGUIDc = "{00020430-0000-0000-C000-000000000046}"
strGUIDd = "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}"
strGUIDe = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}"
strGUIDf = "{8E27C92E-1264-101C-8A2F-040224009C02}"
strGUIDg = "{0006F062-0000-0000-C000-000000000046}"
strGUIDh = "{00062FFF-0000-0000-C000-000000000046}"


'Set to continue in case of error
On Error Resume Next

'Remove any missing references
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set theRef = ThisWorkbook.VBProject.References.Item(i)
If theRef.isbroken = True Then
ThisWorkbook.VBProject.References.Remove theRef
End If
Next i


'Clear any errors so that error trapping for GUID additions can be evaluated
Err.Clear

'Add the reference GUID
For r = 1 To 8
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUID, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDb
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDb, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDc
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDc, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDd
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDd, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDe
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDe, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDf
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDf, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDg
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDg, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select

'Add the reference GUIDh
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUIDh, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select
Next r

On Error GoTo 0
End Sub




Module - code manipulating Outlook (other modules not shown simply copy/paste or sort information in excel)



Sub SetOutlookTask()
ActiveSheet.Unprotect Password:="Karen"
'Setup all of the variables


Dim r As Integer
Dim Rng As Range
Dim olApp As Outlook.Application
Dim olTsk As Outlook.TaskItem
'Const olTaskItem As Integer = 3
Dim cl As Range
Dim chkRng As Range
Dim b As Integer


'Set Rng value to be the date cell below the button
Set Rng = ActiveSheet.Range("C44")

'Setup Outlook and the Task
Set olApp = New Outlook.Application
Set olTsk = olApp.CreateItem(olTaskItem)

'Set the range (rows and column) to search in the loop this is the range for the Due dates.
Set chkRng = Range("K13:K22")
'Check to see if we've already added the Tasks to Outlook if the cell below the button is blank go ahead and process if Not, skip the processing.
If Rng.Value = "" Then

'Look at each Value in the Range and add Task if a date.
b = 9
For Each cl In chkRng
Set olTsk = olApp.CreateItem(olTaskItem) 'create next item
b = b + 1
'MsgBox ("Into the For Loop Cl value " & cl)
If IsDate(cl.Value) Then
'MsgBox ("Into the IF IsDate Loop")
With olTsk
.Subject = Cells(cl.Row - b, 1) + " - " + Cells(cl.Row, 2)
'MsgBox ("Subject is" & olTsk.Subject)
.Status = olTaskInProgress
'MsgBox ("Status is" & olTsk.Status)
If Cells(cl.Row, 10) = 1 Then
.Importance = olImportanceHigh
ElseIf Cells(cl.Row, 10) = 2 Then
.Importance = olImportanceNormal
Else
.Importance = olImportanceLow
End If
'MsgBox ("Importance is" & olTsk.Importance)
.DueDate = Format(cl.Value, "mm/dd/yy")
'MsgBox ("Due Date is" & olTsk.DueDate)
.Save
End With

'Reset for next cl
Set olTsk = Nothing


End If
Next cl
Else
MsgBox "Tasks have already been added to Outlook"
Exit Sub
End If

'Cleanup
Set olTsk = Nothing
Set olApp = Nothing
'Stamp the date below the button
Rng.Value = Date
ActiveSheet.Protect Password:="Karen"
End Sub

Sub CreateOutlookEmail()
ActiveSheet.Unprotect Password:="Karen"
Dim objOLApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim Email As String, Subj As String
Dim EmailAll As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
Dim b As Integer

Set objOLApp = New Outlook.Application
Set NewMail = objOLApp.CreateItem(olMailItem)
' Get the email address
For r = 3 To 11
Email = Cells(r, 4)
If Cells(r, 4) = "" Then
EmailAll = EmailAll
Else
EmailAll = EmailAll & Email & ";"
End If
r = r + 1 'Skip row
Next r
'Check
'MsgBox (EmailAll)
b = Len(EmailAll)
EmailAll = Left(EmailAll, (b - 1))

NewMail.To = EmailAll
NewMail.Subject = Cells(3, 1)
NewMail.Display
'Reset
Set objOLApp = Nothing
Set NewMail = Nothing

ActiveSheet.Protect Password:="Karen"
End Sub



Is there a better way to make this work on multiple versions of Excel? How do I switch this to late binding? Does this make sense?

Switch Dim objOLApp As Outlook.Application to Dim objOLApp As Object

then
Set objOLApp = CreateObject("Outlook.Application")

objOLApp.Visible = True

Finally, I have the reference library Microsoft Calendar Control 10.0. When opening in 2007, this goes missing and I've manually replaced with Microsoft Works Calendar 6.0 Type Library to get it to work. Why is this and can this library check and add be automated?

Thanks!
tca_VB

Bob Phillips
08-14-2008, 11:32 AM
See

http://xldynamic.com/source/xld.EarlyLate.html
Develop Early, Release Late

tca_VB
08-14-2008, 12:32 PM
Thanks XLD - I was able to use that link to update my code to late binding! Much better!

Any ideas on the 2003 file opening in 2007: 2003 has Calendar Reference Microsoft Calendar Control 10.0 library checked, but when opening in 2007, this goes missing and I've manually replaced with Microsoft Works Calendar 6.0 Type Library to get it to work. Why is this and can this library check and add be automated?

There isn't a Microsoft Calendar Control X.X in 2007 - but seems to work selecting the other library. I don't have anything except for a date sort that relates to calendar items.