VB 6.0 Add-in for Outlook

Joined
Jun 8, 2008
Messages
3
Reaction score
0
Hi,

I´m a beginner in VB6 and VBA and made an add-in (to be honest: google and msdn were my friends).

Evrything works perfect, when Outlook is opened. But when Outlook is closed, and I use "send to" with right-click on a file, I get those errors:

- Runtime error - Object-variable or with-variable not determinate
- A dialog field is already opened. Close this first and try it once more.
Those errors are translated. I`m not shure, if the translation is right.

Has anyone, please, an idea, what`s wrong?

Here`s the Code:

Dim WithEvents objButton As Office.CommandBarButton

Public Function FileExists(strFile As String) As Boolean
On Error Resume Next
FileExists = (Len(Dir(strFile)) > 0)
End Function

Function DirExists(ByVal DName As String) As Boolean
Dim sDummy As String
On Error Resume Next
If Right(DName, 1) <> "\" Then DName = DName & "\"
sDummy = Dir$(DName & "*.*", vbDirectory)
DirExists = Not (sDummy = "")
End Function


Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
Dim ol As Outlook.Application
Dim objBar As Office.CommandBar

Set ol = Application
Set objBar = ol.ActiveExplorer.CommandBars.Item("Standard")
Set objButton = objBar.Controls.Add(, , , , True)
With objButton
.FaceId = 59
.Caption = "Butt"
.Style = msoButtonIconAndCaption
.OnAction = "!<" & AddInInst.ProgId & ">"
End With
End Sub

Private Sub objButton_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim Sname As String
Dim x As Integer
Dim myFileName As String
Dim myLine As String
Dim FileNum As Long

myLine = "D:\"

If FileExists("c:\saptemp.ol") = True Then
myFileName = "c:\saptemp.ol"
FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
Line Input #FileNum, myLine
Else
myLine = "D:\"
End If

Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
Sname = myOlSel.Item(x).Subject
Sname = Replace(Sname, "/", sChr)
Sname = Replace(Sname, "\", sChr)
Sname = Replace(Sname, ":", sChr)
Sname = Replace(Sname, "?", sChr)
Sname = Replace(Sname, Chr(34), sChr)
Sname = Replace(Sname, "<", sChr)
Sname = Replace(Sname, ">", sChr)
Sname = Replace(Sname, "|", sChr)
If DirExists(myLine) = True Then
myOlSel.Item(x).SaveAs myLine & Sname & ".msg", olMSG
MsgBox myLine & Sname & ".msg"
Else
MsgBox "Ordner existiert nicht!"
End If
Next x
End Sub


I use as Load-behaviour: "startup".

thanx
Chrusty


 
Back
Top