PDA

View Full Version : [SOLVED] Outbox Outlook



v_gyku
09-14-2005, 04:28 AM
Mail is not goin to the emailid selected but to the outbox in outlook.
why is so?
DRJ if u know pls...... bcos i have taken ur code and embedded in my code.
anyone pls help me...


Set myOlApp = CreateObject("Outlook.Application")
Set EmailItem = myOlApp.CreateItem(olMailItem)
fileName = List1.Text '& " - " & ActiveWorkbook.name
Debug.Print fileName
SaveName = folderPath & "RightAnswersTempWorkbooks" & _
Num & "\" & StripChars(fileName, "[/,\\,*,?,"",<,>,|,:]", "")
ActiveSheet.Copy
Set objworkbook = ActiveWorkbook
objworkbook.SaveAs SaveName
objworkbook.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = txtsubject
.Body = txtmessage
.To = "v_gyku@yahoo.co.in"
.Importance = olImportanceNormal
.Attachments.Add SaveName
.Send
End With
mailsent = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder folderPath & "RightAnswersTempWorkbooks" & Num, True
Set objFSO = Nothing
'objworkbook.Close = True
Application.ScreenUpdating = True
If mailsent = True Then
MsgBox "workbook """ & myFile & """ have been mailed.", vbOKOnly, "RightAnswers"
Else
MsgBox "The """ & myFile & """ cannot be mailed.", vbOKOnly, "RightAnswers"
intFileErrors = intFileErrors + 1
strFileErrors = strFileErrors & myFile & vbCrLf
End If
Set objworkbook = Nothing
Set myOlApp = Nothing
Set EmailItem = Nothing
Objexcel.Quit
' Set Objexcel = Nothing
End If
Exit Sub

Justinlabenne
09-14-2005, 04:46 AM
What's up v_gyku, I have edited your above post with vba tags for readability and am posting a cross post here so others know if someone else is helping you.

Cross Posted Here (http://www.vbforums.com/showthread.php?t=360411)

I wish I could help but I know your project is in vb6 and I don't have access to it to do any testing.

Killian
09-14-2005, 05:56 AM
Have you checked your Send/Recieve setting in Outlook?
I also notice you create an Outlook application but don't quit it. Since Outlook is set to do a send/recieve on closing by default, this might be the problem.

v_gyku
09-14-2005, 06:21 AM
i have checked with oulook settings.
Mail are sent properly from outlook.
But when i send it from my code mail goes to outbox.
i had quit the application at the end.

v_gyku
09-14-2005, 07:47 AM
hey !

Now its sending the mail.yeaaaaaaaah!

one problem when i am trying to delete the temporary folder which i had created for storing a copy of sheet to be mailed its giving me error... (accesses denied.)

prev. when mail was goin to outbox folder was deleting.

Killian
09-14-2005, 08:07 AM
The Access Denied error occurs when an application is still referencing the folder.
You should delete the folder AFTER you have closed the applications that use it (Excel and Outlook)

v_gyku
09-15-2005, 12:43 AM
now the foder is deleting. and i can send a mail perfectly.
When i say send mails. A
Window comes which asks u : outlook is sending a message on behalf of u. this may be virus or ..... do u want to continue.
if wll press yes mail goes but if we say no then error occurs at: .Send

and also I have a browse button on gui which open a new form that contains all the contacts in the format lastname,firstname i have to select the rec. from this list.

Suppose i have selected rec. then it goes to my main form textbox ( suppose u have selected (miranda,neil) then the email address of this person should go in the main form textbox.

this the code which generates the contact list on the form load and sends the selected contents to the main form recipient textbox:


'Dim olApp As Outlook.application
'Dim nmsName As Outlook.NameSpace
Dim Starray As String
Dim strAns As String
Dim str As Integer
Dim strArray()
Dim AppOutlook As outlook.Application
Dim CloseOutlook As Boolean
Dim SaveToFolderArray
Dim SaveToFolderArrayTemp
Const labelFileName = "Contacts Mailing Labels.doc"
'Dim myOlExp As Outlook.Explorer
Private Sub Btnselectemail_Click()
Me.Hide
End Sub

Private Sub Form_Load()
'Function GetContactList() As Boolean
On Error GoTo ContactListErr
'Create an Outlook application object
If IsAppOpen("Outlook", "Application") Then
Set AppOutlook = GetObject(, "Outlook.Application")
CloseOutlook = False
Else
Set AppOutlook = CreateObject("Outlook.Application")
CloseOutlook = True
End If
'Create Outlook namespace object
Dim oNameSpace As outlook.Namespace
Set oNameSpace = AppOutlook.GetNamespace("MAPI")
'Create Outlook contact folder object
Dim oContactFolder As Object
Set oContactFolder = oNameSpace.GetDefaultFolder(outlook.OlDefaultFolders.olFolderContacts)
If (oContactFolder Is Nothing) Or (oContactFolder.Items.Count < 1) Then
GetContactList = False
Else
For Each Contact In oContactFolder.Items
If Contact.Class = olContact Then
lstContactList.AddItem Contact.LastName & ", " & Contact.FirstName
End If
Next
GetContactList = True
End If
Set oNameSpace = Nothing
Set oContactFolder = Nothing
'Exit the Outlook application
If CloseOutlook = True Then
AppOutlook.Quit
End If
Set AppOutlook = Nothing
Exit Sub
ContactListErr:
On Error Resume Next
If Not (oNameSpace Is Nothing) Then
Set oNameSpace = Nothing
End If
If Not (oContactFolder Is Nothing) Then
Set oContactFolder = Nothing
End If
If Not (AppOutlook Is Nothing) Then
If CloseOutlook = True Then
AppOutlook.Quit
End If
Set AppOutlook = Nothing
End If
GetContactList = False
'End Function
End Sub


Sub Sort(inpArray(), inpList)
Dim intRet
Dim intCompare
Dim intLoopTimes
Dim strTemp
For intLoopTimes = 1 To UBound(inpArray)
For intCompare = LBound(inpArray) To UBound(inpArray) - 1
intRet = StrComp(inpArray(intCompare), _
inpArray(intCompare + 1), vbTextCompare)
If intRet = 1 Then
' String1 is greater than String2
strTemp = inpArray(intCompare)
inpArray(intCompare) = inpArray(intCompare + 1)
inpArray(intCompare + 1) = strTemp
End If
Next
Next
inpList.Clear
For intCompare = 1 To UBound(inpArray)
inpList.AddItem inpArray(intCompare)
Next
End Sub

v_gyku
09-16-2005, 12:45 AM
I got the code for click yes no of outlook..
But actually i didn't understand the code perfectlly...
can u help me to embedd this code in my code?

This is the code i got from the site...



' Declare Windows' API functions
Private Declare Function RegisterWindowMessage _
Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Sub SomeProc()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long

' Register a message to send
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")

' Find ClickYes Window by classname
wnd = FindWindow("EXCLICKYES_WND", 0&)

' Send the message to Resume ClickYes
Res = SendMessage(wnd, uClickYes, 1, 0)

' ...
' Do some Actions
' ...

' Send the message to Suspend ClickYes
Res = SendMessage(wnd, uClickYes, 0, 0)

End Sub



This is my code :



Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
fileName = List1.Text '& " - " & ActiveWorkbook.name
Debug.Print fileName

SaveName = folderPath & "RightAnswersTempWorkbooks" & Num & "\" & StripChars(fileName, "[/,\\,*,?,"",<,>,|,:]", "")
ActiveSheet.Copy
Set Wkb = ActiveWorkbook
Wkb.SaveAs SaveName
Wkb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = txtsubject
.Body = txtmessage
.To = Txtname
.Attachments.Add Wkb.FullName
.send
End With
send = True


'Wkb.Close False

Application.ScreenUpdating = True
Wkb.Close True
' Wkb.Quit
Set Wkb = Nothing
objexcel.Quit
Set objexcel = Nothing
Set EmailItem = Nothing
OL.Quit
Set OL = Nothing
If send = True Then
MsgBox ("Selected sheet is mailed to the selected recipient.")
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder folderPath & "RightAnswersTempWorkbooks" & Num, True
Set objFSO = Nothing
End If
End If
End Sub

v_gyku
09-19-2005, 09:16 PM
edited

Ivan F Moala
09-20-2005, 01:03 AM
If you have installed Click yes then place the call to Sub [SomeProc]the 1st code, after [send = True]