Word VBA: Static Status dialog window - vba

I've created a form that works well with macros running in the background to validate data and then print the document to a specific printer on the network.
The key element of this process is a production number value which I would like to keep a running log of and display in a static status dialog window. In other words, a popup window similar to a MsgBox that would not interfere with other actions on the form, but float on top of the document.
Visual concept of this would be...
User could shift the window away from their work if needed. Close the window if they desired, but pragmatically I want to re-pop/refresh the data in the window each time the background macro completes.
I can't use MsgBox, because it forces a closure of the window before the user can continue working on the document. I just want this visible to the user so they know what was last worked on and the few prior to that.
Any idea what control I might be able to use, or switch to MsgBox that would allow the user to continue working?
Ken...
PS: I found this and am trying to find a way to make this work for me. So far I have managed to get to function in the manner I want, but the lingering issue is how to call this PS script and include the information I need to display.
Alternatives to MsgBox in VBScript - StackOverflow
PPS: I opted to go a slightly different route and release the form with a MsgBox that is displayed at the end of the macro. I describe this in the solution noted below.

Instead of using a MsgBox, please consider using a VBA Userform. They're not much more complicated to use than a MegBox, but you can set them to be Modeless. Modeless dialogs remain open on-screen while you work on the Word document. Here'is Microsoft's page on setting dialogs as Modal or Modeless: Show method
If you search on VBA modeless dialog, you'll find many other helpful pages on the subject.

After doing much research, I've come back to revising my macro to incorporate static variables and a MsgBox at the end to report the last 5 production numbers that have been printed.
To provide a means of bringing up this MsgBox for reference, between printing runs, I created an OnlyNum variable as string and replaced the MsgBox I had for letting the users know they were only to use numbers in this field with that message. The end of that trap diverted the flow to the bottom of the macro (where the MsgBox that displayed the last five print jobs has been placed).
So, when the status MsgBox is displayed as a result of printing it only shows the last five events. If the trap captures it, it shows the message letting the user know to only use numerals and then displays the last five events.
Code reference:
Private Sub CommandButton1_Click()
Dim Prod As String
Dim Temp As String
Dim OnlyNum As String
Static ProdNum1 As String
Static ProdNum2 As String
Static ProdNum3 As String
Static ProdNum4 As String
Static ProdNum5 As String
'Check for only numeric value of TextBox1.Text
If Not IsNumeric(TextBox1.Value) Then
OnlyNum = "only numbers allowed" & vbCrLf & vbCrLf
Cancel = True
GoTo NotToday
End If
'Remove any spaces from TextBox1.Text
Prod = Replace(TextBox1.Text, " ", "")
'If the resulting lenght is equal to 7 Print it.
If Len(Prod) = 7 Then
ActiveDocument.PrintOut
'Update recent production numbers (5 in total)
ProdNum5 = ProdNum4
ProdNum4 = ProdNum3
ProdNum3 = ProdNum2
ProdNum2 = ProdNum1
ProdNum1 = Prod & " - " & Now() ' Insert a new production number with timestamp
TextBox1.Text = "" 'Clear the value of TextBox1.Text to prepare for the next Production number
Else
MsgBox ("Production Numbers must be 7 digits and contain only numerials.")
End If
NotToday:
Application.ActivePrinter = Temp
MsgBox (OnlyNum & ProdNum1 & vbCrLf & ProdNum2 & vbCrLf & ProdNum3 & vbCrLf & ProdNum4 & vbCrLf & ProdNum5)
OnlyNum = "" 'Reset value of OnlyNum
End Sub

Related

Macro for saving a local copy of a mail (and renaming the local copy)

Company i work for manually saves certain requests (sent per mail) to a shared drive, renaming them as such: "YYYYMMDD_Firstname_Lastname". The mails are saved as .msg
Since we get about a hundred of these per week, I'd like to macro this so I don't waste time.
The article here: Outlook VBA macro for saving emails copies in a local folder explains how to save files locally, but I'd like to make following additions:
- Rename the copy before it gets saved to the shared drive (manually if needed)
- Select the shared path it needs to be saved to (preferably a drop-down with three choices)
- create a proper userform for this
If anyone could assist with the code, or provide me with tutorials/guides on how to do this myself, I'd be extremely grateful.
P.S. just started using and creating macro's a week ago. Still very much a beginner. any link to a good tutorial for developers would be greatly appreciated, regardless of whether it answers my questions.
Thanks guys!
Used the code described in the article as such:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Call SaveACopy(Item)
End Sub
Sub SaveACopy(Item As Object)
Const olMsg As Long = 3
Dim m As MailItem
Dim savePath As String
If TypeName(Item) <> "MailItem" Then Exit Sub
Set m = Item
savePath = "c:\users\your_user_name\desktop\" '## Modify as needed
savePath = savePath & m.Subject & Format(Now(), "yyyy-mm-dd-hhNNss")
savePath = savePath & ".msg"
m.SaveAs savePath, olMsg
End Sub
Update: using the macro provided by Tony Dallimore I've amanaged to identify that .SenderName is the main info I need from the mails to be processed. All I need now is to replace the spaces in that output by underscores, and add the date in reverse in front of it to have my filename.
Thanks a bunch to Tony Dallimore for the continuous assistance on this project.
Since it seems somewhat confusing looking back on my original question, I'll try to clarify:
I get about 100 mails a week informing us of approvals of certain user requests.
Company policy is to save these mails as .msg on a shared drive used for administration before processing the request. The filename of these messages needs to be as such:
"YYYYMMDD_FIRSTNAME_LASTNAME.msg" (with YYYY being the year, MM being the month, and DD being the day on which we received these mails)
We get three main "types" of such mails, saved in different locations, but using the same filename respectively.
What I'd need is a macro or set of macros that can save these mails in the correct networkdrive under the correct format at the press of a button, or using minimal clicks/manual input.
I've decided to use .SenderName and .Senton, since those seem to give me most of what I need.
This is not a direct answer to your question. It is an investigation which I hope will provide the information necessary for an answer.
You say “… mails are auto-generated by the system …”. This may explain why I do not fully understand why your code works. I will explain my confusion after I have provided some background.
There are four distinct methods by which a MailItem can be selected for processing:
The user can select one or more emails and then call a macro to process the selected MailItem. (Note it is an email to the user but a MailItem to a macro.)
A macro can read up or down a folder of MailItems, reviewing properties to determine which are to be processed. Sort and Filter can be used to more quickly target the MailItems of interest.
You can specify a rule that will look at each email as it arrives and review properties such as subject and sender. If the email has the required properties, a number of actions can be performed. If the standard actions are not adequate, you can link a macro to perform any action available to a VBA macro.
You can instruct Outlook to call a macro whenever a particular event occurs. Events include: MailItem added to folder Xxxx,MailItem opened, MailItemsent, MailItemsaved, MailItem closed, MailItem replied to or MailItem forwarded.
Your code is using approach 4. In particular, you are using a MailItemsent event. You say “ … we get about a hundred of these [emails] per week …”. If “get” is the correct word, I would expect MailItem added to folder Inbox to be the appropriate event. Perhaps your code works because the system is generating emails from user X to user X.
If these emails are generated by the system, we cannot be sure what properties are set and what values they are set to. Please copy the code below to an Outlook module. Select one or more of these emails and run macro CallSubForSelectedEmails.
Option Explicit
Public Sub CallSubForSelectedEmails()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
If ItemCrnt.Class = olMail Then
Call DsplSimpleProperties(ItemCrnt)
End If
Next
End If
End Sub
Sub DsplSimpleProperties(ItemCrnt As Outlook.MailItem)
Dim InxR As Long
Debug.Print "=============================================="
Debug.Print " Profile: " & Session.CurrentProfileName
Debug.Print " User: " & Session.CurrentUser
With ItemCrnt
Debug.Print " Created: " & .CreationTime
Debug.Print " Receiver: " & .ReceivedByName
Debug.Print " Received: " & .ReceivedTime
For InxR = 1 To .Recipients.Count
Debug.Print "Recipient: " & .Recipients(InxR)
Next
Debug.Print " Sender: " & .Sender
Debug.Print " SenderEA: " & .SenderEmailAddress
Debug.Print " SenderNm: " & .SenderName
Debug.Print " SentOn: " & .SentOn
Debug.Print " Subject: " & .Subject
Debug.Print " To: " & .To
End With
End Sub
For one of my emails, this routine outputs:
==============================================
Profile: Outlook
User: Tony Dallimore
Created: 08/04/2019 19:59:22
Receiver: Tony Dallimore
Received: 08/04/2019 18:45:39
Recipient: a.j.dallimore#acmeisp.com
Sender: Lifecake
SenderEA: support#lifecake.com
SenderNm: Lifecake
SentOn: 08/04/2019 18:45:37
Subject: ?? Someone commented on Alex and Eric's video
To: a.j.dallimore#acmeisp.com
Note 1, I am both the system user and the receiver of this email. This gives two possible ways of getting my first and last names. I use initials in my email address but your company may use names.
Note 2: my code uses approach 1 to select the emails to be processed. Macro CallSubForSelectedEmails calls macro DsplSimpleProperties for each selected email. I do all my investigations and all my development of email processing macros using code like this. This gives me complete control over which emails are processed. The call profile for macro DsplSimpleProperties is the same as that for a rule macro or an event macro. Once I have debugged my macro using approach 1 and switch to calling it from a rule or an event with minimal additional testing. I know of no easier way of debugging email processing macros.
Again this is not a complete answer because I do not have the information for a complete answer.
Task 1: Generate PathName
The information for the path name comes from the MailItem's Subject. For this example, I assume the request type is 1, 2 or 3 and it is the last character of the subject.
Dim PathName As String
' Generate end of subfolder name
Select Case Right$(ItemCrnt.Subject,1)
Case "1"
PathName = "xxxx"
Case "2"
PathName = "yyyy"
Case "3"
PathName = "zzzz"
Case Else
' Subject does not conform to expected format.
Exit Sub
End Select
' Prefix root folder name and year of subfolder name
PathName = "P:\EMEA Requests\" & Year(ItemCrnt.SentOn) & "\" & PathName
Right$ is a function that extracts a specified number of trailing characters from a string. Functions Left$ and Mid$ are also available. If the subject is sufficiently complicated, we can consider Regex. Year is a function that extracts the year from a date. The value will be an integer but VBA will automatically convert it to a string if it used as a string.
If the routine cannot identify the request type, it abandons the MailItem. I will discuss this issue later.
Task 1; Suggestion 2: Generate PathName
You say the subjects lack a fixed format and just include words from the original request. You imply these words are good enough for a human to identify the request type. So the words for a request might include "hardware", "h'ware", "computer" or "laptop". Another request might include "software", "application or "app". This is a simple method of handling this type of situation. There is a better method which I will introduce if this looks feasible.
If Instr(1, LCase(ItemCrnt.Subject), "hardware") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "h'ware") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "computer") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "laptop") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "software") <> 0 Then
PathName = "yyyy"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "application") <> 0 Then
PathName = "yyyy"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "app") <> 0 Then
PathName = "yyyy"
Else
PathName = ""
End If
You can keep adding possible keywords until your requestors run out of alternatives. Failing that you can use your userform with buttons approach after the macro has handled the easy messages.
Task 2: Generate FileName
Dim FileName As String
FileName = Format(ItemCrnt.SentOn, "yymmdd") & " " & Replace(ItemCrnt.SenderName," ", "_")
Task 0: Design
Before coding can start, you need to design the total process. You can start with something simple and then develop it as you better understand your requirement. You can code little bits as I did with PathName and FileName so you can understand the bits you need to fit together. But tackling something complex without a plan rarely ends satisfactorily.
My understanding of your requirement is incomplete but I will have a go at a design.
I would have a Rule that copied incoming emails of this type to an Outlook folder such as "Unsaved EMEA Requests". Note: these are copies; the original remains in the Inbox for processing as required. I assume there is a way to identify these emails that is within the functionality available to a rule.
I would have all the code in a macro which I would call once or twice a day as appropriate. This macro would read up folder "Unsaved EMEA Requests". If it can generate a path and file name for a message, it will save the message to the required disc folder and delete the message from the Outlook folder. If it could not process a message, it would leave it in Outlook folder "Unsaved EMEA Requests". If a message is left in Outlook folder "Unsaved EMEA Requests", you will know (1) that the macro needs enhancing to handle a previously unencountered message type or (2) the rule needs amending because it has copied the wrong sort of message.
I said "read up folder" not "read down folder". You access a MailItem within a folder by its position: 1, 2, 3, … Folder.Count. If you delete MailItem 2 then MailItem 3 becomes MailItem 2, MailItem 4 becomes MailItem 3 and so on. The value of Folder.Count is reduced by one. You sometimes see questions asking why their macro is only processing every other MailItem. The reason is they have coding like:
For InxI = 1 to Folder.Count
' Process and delete Folder.Item(InxI)
Next
With the above code, you process items 1, 2, 3 in turn. If you delete item 2, you will skip the original item 3 because it is now item 2.
The correct code is:
For InxI = Folder.Count To 1 Step -1
' Process and delete Folder.Item(InxI)
Next
With this code you process items 10, 9, 8, 7 in turn. If you delete item 9, you do not care that item 10 has become item 9 because you are now processing item 8.
If you are only reading items, you do not need to worry above this issue. But if you are adding or deleted items, you do need to worry about it.

Access 2010 - Store JPG as OLE Object using filename path from field in same record

I have scoured the net for days trying to figure this out, but apparently my gaps in Access are too severe and the answer eludes me. Someone has apparently already answered this question, however I'm not able utilize the information.
My specific situation:
Table1 has 30,000+ rows and multiple columns. "Photo Path" is a text field with the path and filename of an image. "Photo" is an OLE Object field currently empty.
What I would like to do is store the image specified in "Photo Path" as an OLE object in "Photo".
Table1 Current State:
Name - Photo Path - Photo
Impala - C:\Cars\Impala.jpg -
Jeep - C:\Cars\Jeep.jpg -
Table1 Desired Result:
Name - Photo Path - Photo
Impala - C:\Cars\Impala.jpg - LONG BINARY DATA
Jeep - C:\Cars\Jeep.jpg - LONG BINARY DATA
I don't know how to execute FileToBlob() against my entire database using the generously provided code. The authors seem to expect me to use a form, which I was unable to get to work as well.
What I think I want is an SQL statement that will execute against every row in Table1 using FileToBlob() or something close to it.
I've tried variations of the following statement in the SQL Query to no avail.
SELECT Table1.[Photo Path], FileToBlob(Table1.[Photo Path],Table1.Photo) As Photo
FROM Table1;
Thank you for taking the time to read this and providing an answer.
Had to figure this one out for myself as there were no responses. For those may follow looking for an actual answer, here it is.
I modified the code that that I found to fit my specific problem.
Create a new module and put the code below in it. If by chance the code does not work, you can try going to Tools-->References and if not already selected, select "Microsoft DAO X.x Object Library" where X.x is the latest library. If it still doesn't run you'll have to check to see if you need to select any other references.
There are so many records to go through, I felt better doing this through code instead of a query that may take a long time to execute and one won't know what is going on. In the code I have it writing to the status bar in Access so you know where you are at (but if the files are small it will probably fly by, but at least you know it is working).
To run the code, just put your cursor anywhere in the routine and I first like to press F8 which steps into the code just to make sure I'm in the right routine. Then press F5 to run the rest of the code. If you want to create a form to run the code instead you can do that too. Just create a button and on the "on click" event add the code:
call Load_Photo()
If you want to see the status updates, make sure the main access window is visible before you run the code (If you run from a form, it will already be there).
Note I renamed the field "Name" in Table1 to "strName" because "Name" is a reserved word. I'd suggest not using "Name" as a field name. You might be OK, but you could run into issues at some point, especially when referencing the field through code. If you choose not to change the field name, change the code.
Also note that the sample code provided stored as a binary. So if you create an Access form to show the records, the image will not automatically appear - there is some other manipulation necessary that I am not familiar with off hand.
Without further ado, here's the code to solution I was looking for:
Option Compare Database
Option Explicit
Public Sub Load_Photo()
On Error GoTo LoadFileError
Dim strSQL As String
Dim rstTable As DAO.Recordset
Dim strStatus As String
Dim count As Integer
Dim strFile As String
Dim nFileNum As Integer
Dim byteData() As Byte
Dim varStatus As Boolean
'
' In case something happens part way through the load, just load photos that have not been loaded yet.
'
strSQL = "Select [strName], [Photo Path], [Photo] from Table1 Where [Photo] is null"
Set rstTable = CurrentDb.OpenRecordset(strSQL)
If rstTable.RecordCount > 0 Then
rstTable.MoveFirst
count = 0
Do While Not rstTable.EOF
strFile = rstTable![Photo Path]
If Len(Dir(strFile)) > 0 Then
nFileNum = FreeFile()
Open strFile For Binary Access Read As nFileNum
If LOF(nFileNum) > 0 Then
count = count + 1
'
' Show user status of loading
'
strStatus = "Loading photo " & count & " for " & rstTable![strName] & ": " & rstTable![Photo Path]
varStatus = SysCmd(acSysCmdSetStatus, strStatus)
DoEvents
ReDim byteData(1 To LOF(nFileNum))
Get #nFileNum, , byteData
rstTable.Edit
rstTable![Photo] = byteData
rstTable.Update
Else
MsgBox ("Error: empty file, can't load for Name = " & rstTable![strName] & " and Photo Path = " & rstTable![Photo Path])
End If
Close nFileNum
Else
MsgBox ("Error: File not found for Name = " & rstTable![strName] & " and Photo Path = " & rstTable![Photo Path])
End If
rstTable.MoveNext
Loop
End If
LoadFileExit:
If nFileNum > 0 Then Close nFileNum
rstTable.Close
strStatus = " "
varStatus = SysCmd(acSysCmdSetStatus, strStatus)
Exit Sub
LoadFileError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error on " & strFile
Resume LoadFileExit
End Sub

Run a Query Using a Button in Access

I am trying to run a query in Access 2010 inside of a form. The form, per user request, needs to have buttons that they can use to quickly change the data in their column. For the table being called, there are only two columns that matter: Equiptment_Name and Amount (The other several columns are just there to help reference the data in case they misspell the name of the product). The current query I have is:
UPDATE tblInventory SET Amount = Amount-[Enter Amount]
WHERE ((([tblInventory].Equiptment_Name)=[Enter Name]));
This works perfectly, I just can't get it to work in a form with a button. I've searched all over for help and was encouraged to use a macro because that would be the easiest way. Can someone please walk me through the process of getting a macro to run a version of my query? I'm fine with the user being prompted to enter the amount to withdraw from the Amount category, but it would be nice if they didn't have to type in the Equiptment_Name category since The button would be in the form next to it (see picture below). Thanks for all help in advance.
You could simply use VBA to get this going. Something along the lines of
Private Sub Command70_Click()
If Len(Me.AmountTextBoxName & vbNullString) = 0 Then
MsgBox "Amount cannot be empty !", vbCritical
Exit Sub
End If
If Len(Me.Equiptment_NameTextBoxName & vbNullString) = 0 Then
MsgBox "Equiptment Name cannot be empty !", vbCritical
Exit Sub
End If
CurrentDB.Exeucte "UPDATE tblInventory SET Amount = Amount - " & Me.AmountTextBoxName & _
"WHERE tblInventory.Equiptment_Name = '" & Me.Equiptment_NameTextBoxName & "';"
End Sub
I have taken the Equipment name is actually a String.

Attachmate receive host string and react with conditional response using VBA

Using Attachmate, I am trying to write a VBA script that reacts when a specific phrase occurs and automatically executes commands via inline commands. Essentially, when a phrase appears, an inputbox appears asking the user for a specific quantity and the VBA code takes that quantity, inserts it into the terminal and then jumps around different menus to create an internal label. However, my problem is that I don't know how to have the VBA code react to the different strings that may be returned by the host. Sometimes it says "enter to continue" and sometimes it says "select user". So what I want it to do is based on the statement it receives to do a certain action, but I don't know what the command is for capturing what the terminal is receiving from the host. I've tried "waitforstring" and "readline" but it is obvious I am not using them correctly. Below is the code I have built thus far, please be gentle as it is still very unfinished. I have commented out several parts of it in attempts to troubleshoot my problems:
'variable declarations
Dim count As Long 'var used to indicate how many times code should loop (how many labels should be print)
Dim drugname As String
Dim qtyinput As Long
Dim CR As String ' Chr(rcCR) = Chr(13) = Control-M
Dim LF As String ' Chr(rcLF) = Chr(10) = Control-J
Dim strcheck As String
'assign values to variables
count = 0
CR = Chr(Reflection2.ControlCodes.rcCR)
LF = Chr(Reflection2.ControlCodes.rcLF)
qtyinput = InputBox("Number of items being sent", Quantity)
drugname = .GetText(22, 15, 22, 46) ' StartRow:=22, StartColumn:=15,EndRow:=22, EndColumn:=46 'copies text from screen
' Press EditCopy (Copy the selection and put it on the Clipboard).
'.Copy rcSelection, rcAsPlainText -- not needed
.Transmit qtyinput & CR
.Transmit CR
'strcheck = .readline("00:00:01")
'MsgBox strcheck
'If .WaitForString("Press " & Chr(34) & "RETURN" & Chr(34) & " to continue, " & Chr(34) & "^" & Chr(34) & " to stop: ") Then .Transmit CR
'Select Case strcheck
' Case strcheck Like "to continue"
' .Transmit CR
'Case strcheck Like "*Select CLIENT*"
' .Transmit CR
'End Select
.Transmit "^MED" & CR
.Transmit "3" & CR
.Transmit "10" & CR
First of all, Attachmate is the company, and they have a few products for accessing Mainframe sessions from Windows including EXTRA! and Reflections, both of which share a common scripting language, which is nice and easy to use from within VBA.
However, EXTRA! tends to have fewer commands available to use than Reflections, which is the more expensive product, so you have to get a little creative with your VBA.
I think you are using EXTRA!, so the command you are looking for is "GetString"
I use VBA to interact with a mainframe session in EXTRA!, and I know that my mainframe command is successful when three stars appear on the screen in a certain position.
The mainframe command can take anywhere between 1 second and 5 minutes to complete, so I use "GetString" to poll the mainframe session every second, waiting for the three stars before I continue:
Do Until Sess0.Screen.GetString(14, 2, 3) = "***"
Application.Wait (Now + TimeValue("0:00:01"))
Loop
The syntax for "GetString" is: GetString(Row, Column, Length)
In my case the stars appear at row 14, column 2, and I know there will always be 3 of them, so I set my string length to 3.

How to send a same reply mail (template saved in outlook) to the mail sender (to, cc)?

I am receiving continues emails from customer (different customers) to update their asset details in database.. once process done .. I have to reply (including cc) from their mail telling like "asset details successfully stored in Database" (am using template) using VBA.
Option Explicit
Public Sub ReplyToAll()
Dim oExp As Outlook.Explorer
'for selected mails in outlook
Dim oSM As mailItem
Dim oNM As mailItem
On Error GoTo Err
Set oExp = Outlook.Application.ActiveExplorer
'Check if something is selected
If oExp.Selection.Count > 0 Then
'Get the first item selected
Set oSM = ActiveExplorer.Selection.Item(1)
'Create a Reply template
Set oNM = oSM.ReplyAll
With oNM
'Change the subject
.Subject = "RE: " & oSM.Subject
'Change the body
.Body = .Body & Chr(13) & Chr(13)
'Display the new mail before sending it
.Display
End With
End If
Exit Sub
Err:
MsgBox Err.Description, vbCritical
End Sub
section 3
Sub ReplyAll()
Dim objOutlookObject As mailItem
For Each objOutlookObject In GetCurrentOutlookItems
With objOutlookObject
.ReplyAll.Display
'prob area code does not include the template saved in the location c ..throws some error
.createitemtemplate("c:\car.jtm")
End With
Next
End Sub
Function GetCurrentOutlookItems() As Collection
Dim objApp As Outlook.Application
Dim objItem As Object
Dim colItems As New Collection
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
For Each objItem In objApp.ActiveExplorer.Selection
colItems.Add objItem
Next
Case "Inspector"
colItems.Add objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
Set objApp = Nothing
Set GetCurrentOutlookItems = colItems
End Function
I am sorry my comment was so curt; 500 characters does not leave much room for a full answer.
Your question is very unclear so it is likely to be closed. Certainly, I do not see how anyone could answer it. That is why it is important that you try to solve your own problem and return as necessary with specific questions.
Below I provide links to recent posts that I believe will help you get started. As I said in my comment, look through recent posts. Use the search facility. There are some very good answers here if you look for them.
The first two posts are tutorials written by me. The early steps are the same but, because the questions were not quite the same, later steps are different. Look at both and pick out the bits relevant to you. The others posts all contain information you may find helpful.
How to import the outlook mail data to excel
update excel sheet based on outlook mail
could anyone guide me in creating an outlook macro that does the following
send an email from excel 2007 vba using an outlook template set variables
using visual basic to access subfolder in inbox
vba outlook event moving email
New section in response to new information from questioner
Except for minor modifications, the code in your question was taken from the Microsoft Help file for NewMailEx Event. This code will only work if you have the correct type of installation and if you place it in the correct place:
"The NewMailEx event will only fire for mailboxes in Microsoft Outlook that provide notification for received message such as Microsoft Exchange Server. Also, the event will fire only if Outlook is running. In other words, it will not fire for the new items that are received in the Inbox when Outlook was not open. Developers who want to access these items for customers running Outlook on an Exchange server e-mail account need to implement their code on the server. However, the NewMailEx event will fire against Cached Exchange Mode in all settings: Download Full Items, Download Headers, and Download Headers and then Full Items."
Do you have the correct type of installation? Can you place your code on the server? Even if this is the correct approach for the final version of your macro, I do not believe it is the correct approach while you are learning VBA and Outlook.
You need two things:
a detailed specification of the macro you wish to write and
more understanding of VBA and Outlook.
I doubt you can create the detailed specification yet because you do not know enough about VBA and Outlook. But we can list things you will need to know:
How do you write to your database from Outlook?
How do you identify the mail items you wish to record? In your example, you are checking for a subject of "Hello" and replying "Hi". This is fine for a first experiment but you need to identify the real method. Is it a new sender? Is there specific information in the body of the message? Does a human have to identify such mail items?
In your example, you have a folder "Personal" under "Inbox". Many people seem to have this type of folder structure and Microsoft examples tend to use folders like this. I do not. I have a folder called "!Home". Under this I have folders for "Insurance", "Shopping", "Money". Under these I have folders for my different suppliers. Once I have dealt with a message, I move it to appropriate folder. Replies go to the same folder. This is my system and it works for me. What is your system going to be? Will, for example, there be a single folder for all customers or one per customer?
The above is a starter list of questions for your specification but it is also a starter list of things you need to know.
Perhaps you have a boss who wants you to stop wasting time and start writing the macro but you do not know enough yet to plan the final macro.
Start with my tutorials. The first three steps are about the folder structure. These steps are essential if you have the kind of complex folder structures I have. Next I go through a folder displaying selected information from each mail item. I have steps in which I write message bodies to disc. I suggest you go through both tutorials and try my code. Not all of it will be immediately useful but it is all good background information.
What is your database? Is it Access or Excel? There is some help in my tutorials and in the other links above with writing to Excel which you could adapt for Access.
I think the above is enough for now. Take it slowly and it will start to make sense. I still remember the first time I tried to write an Outlook macro so I understand your confusion. I promise that it will become clear. Best of luck.
New section in response to the following comment:
"hello i have tried ..Got what i want....Removed my previous code..and tried replaced the new code .. Now little help needed from you ....is there any way to use same format like when we click the replyall button in outlook .. my code working fine ..prob is format of the mail is differ .."
Problem 1
.Body = .Body & Chr(13) & Chr(13)
You are using the text body. I think you want the HTML body. Try:
.HTMLBody = .HTMLBody & Chr(13) & Chr(13)
Problem 2
You cannot add to the HTML body in this way. The HTML body will be:
<!doctype ...><html><head> ... </head><body> ... </body></html>
You must add your text to the beginning of the body; that is, just after <body>. If you just add your text, you will be accepting whatever style, margins and colours the sender has used. The following code adds some text that looks the same in every email I have tried it with. My text is within a table with a single cell. The table covers the full width of the page. The text is blue on a white background.
Dim InsertStg As String
Dim Inx As Long
Dim Pos As Long
'Change the body step 1: Create the string to be inserted
InsertStg = "<table border=0 width=""100%"" style=""Color: #0000FF""" & _
" bgColor=#FFFFFF><tr><td><p>"
For Inx = 1 To 10
InsertStg = InsertStg & "Sentence " & Inx & " of first paragraph. "
Next
InsertStg = InsertStg & "</p><p>"
For Inx = 1 To 10
InsertStg = InsertStg & "Sentence " & Inx & " of second paragraph. "
Next
' The following adds a signature at the bottom of the message.
' "font-family" gives a list of fonts to be tried. If these are
' missing from your computer, use the names of fonts you do have.
' "serif" means that if none of the fonts exist any serif font
' that exists is to be used.
InsertStg = InsertStg & "</p><p style = ""font-family: Mistral, " & _
"Vivaldi, serif; font-size: 14px; color: " & _
"rgb(127,0,127)"">John Smith<br>5 Acacia Avenue<br>"
InsertStg = InsertStg & "</p></td></tr></table>"
'Change the body step 2: Find insertion position just after <Body> element
Pos = InStr(1, LCase(.HTMLBody), "<body")
If Pos = 0 Then
Call MsgBox("<Body> element not found in HTML body", vbCritical)
Exit Sub
End If
Pos = InStr(Pos, .HTMLBody, ">")
If Pos = 0 Then
Call MsgBox("Terminating > for <Body> element not found in HTML body", vbCritical)
Exit Sub
End If
'Change the body step 3: Insert my text into body
.HTMLBody = Mid(.HTMLBody, 1, Pos) & InsertStg & Mid(.HTMLBody, Pos + 1)