Sending mail from Excel with CDO

What is CDO doing

The example code is using CDOSYS (CDO for Windows 2000).
It does not depend on MAPI or CDO and hence is dialog free
and does not use your mail program to send email.


Briefly to explain, this code builds the message and drops it
in the pickup directory, and SMTP service running on the machine
picks it up and send it out to the internet.


Why using CDO code instead of Outlook automation or SendMail in VBA.

1: It doesn't matter what Mail program you are using (It only use the SMTP server).
2: It doesn't matter what Office version you are using (97…2007)
3: You can send a range/sheet in the body of the mail (some mail programs can’t do this)
4: You can send any file you like (Word, PDF, PowerPoint, TXT files,….)
5: No Security warnings anymore, really great if you are sending a lot of mail in a loop.


Read this!!!

This code will not work in Win 98 and ME.
You must be connected to the internet when you run a example.

It is possible that you get a Send error when you use one of the examples.
AFAIK : This will happen if you haven't setup an account in Outlook Express or Windows Mail.
In that case the system doesn't know the name of your SMTP server.
If this happens you can use the commented green lines in each example.
Don't forget to fill in the SMTP server name in each code sample where
it says "Fill in your SMTP server here"

When you also get the Authentication Required Error you can add this three lines.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"

Don't remove the TextBody line in the code. If you do you can't open the attachment (bug in CDO).
If you don't want to have text in the body use this then .TextBody = ""

Note: It is always possible that your firewall block the code (Check your firewall settings)


Can you use CDO on your machine?

Let's try a basic example first.

The code below will send four text lines in the body of the mail to the person in this line
.To = "ron@debruin.nl"

Change ron@debruin.nl to your own mail address before you test the code.
If you read the information above you know that if you have a account in Outlook Express or
Windows Mail you can Run the code below after changing the mail address.
But if you not have a account in Outlook Express or Windows Mail you also need the commented
green lines in the code. Remove every ' before every green line and fill in the name of your SMTP server
where it says "Fill in your SMTP server here"

1) Open a new workbook
2) Alt F11 (to open the VBA editor)
3) Insert>Module
4) Paste the code in this module
5) Make your changes
6) Alt q to go back to Excel

When you use Alt F8 you can select the macro and press Run.
Now wait a moment and see if you receive the mail in your inbox.

Sub CDO_Mail_Small_Text()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    '    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    '    iConf.Load -1    ' CDO Source Defaults
    '    Set Flds = iConf.Fields
    '    With Flds
    '        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
    '                       = "Fill in your SMTP server here"
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    '        .Update
    '    End With

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    With iMsg
        Set .Configuration = iConf
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .From = """Ron"" "
        .Subject = "New figures"
        .TextBody = strbody
        .Send
    End With

End Sub

Note: If you get this error : The transport failed to connect to the server
then try to change the SMTP port from 25 to 465



Use the GMail SMTP server from Google.
http://gmail.google.com

You can find the code in the workbook with examples that you can download below.
There is more information about the code in the workbook.
Note: You must have a Gmail account to try this example.




Download workbook with more examples

You can download a example workbook with eighth examples.
Download Example workbook with all the code

Attachment examples:
Module file1 = Workbook
Module file2 = One worksheet or more
Module file3 = Every sheet with a mail address in cell A1

Body examples:
Module body1 = Selection/Range or whole worksheet
Module body2 = Personalized Mail
Module body3 = Every sheet with a mail address in cell A1
Module body4 = Small text and text from a txt file

Note: the body examples in the workbook are using the function RangetoHTML in
the "bodyfunction" module of the workbook.

Gmail example:
Module gmail = Use the smtp.gmail.com server from Gmail to send mail



Tips and links


CDO sheet template

Check out this sheet template if you want to send every sheet to a different person.
Or want to send one or more sheets to one or more recipient.
http://www.rondebruin.nl/mail/templates.htm



Set importance/priority and request read receipt

For importance/priority and read receipt you can add this in the With iMsg part of the macro before .Send

' Set importance or Priority to high
.Fields("urn:schemas:httpmail:importance") = 2
.Fields("urn:schemas:mailheader:X-Priority") = 1

' Request read receipt
.Fields("urn:schemas:mailheader:return-receipt-to") = "ron@debruin.nl"
.Fields("urn:schemas:mailheader:disposition-notification-to") = "ron@debruin.nl"

' Update fields
.Fields.Update


Changing the To line

If you want to mail to all E-mail addresses in a range then use this code
instead of .To = "ron@debruin.nl"

The example below will use the cells from sheets("Sheet1") in ThisWorkbook (workbook with the code)
It is possible that you must use ActiveWorkbook or something else in your code to use it.

    Dim cell As Range
    Dim strto As String
    On Error Resume Next
    For Each cell In ThisWorkbook.Sheets("Sheet1") _
        .Range("A1:A10").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
            strto = strto & cell.Value & ";"
        End If
    Next cell
    On Error GoTo 0
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

Change the To line to .To = strto


Or to more people
.To = "Jon@something.com;ron@something.com"

Or you can use a address in a cell like this
.To = Sheets("Sheet1").Range("C1").Value



Change the Body line


Plain text :

Note: see also the example in the workbook to send all text from a txt file (Module body4)

If you want to add more text to the body then you can use the code below.
Instead of .TextBody = "This is the body text" use .TextBody = strbody then.

Dim strbody As String
strbody = "Hi there" & vbNewLine & vbNewLine & _
    "This is line 1" & vbNewLine & _
    "This is line 2" & vbNewLine & _
    "This is line 3" & vbNewLine & _
    "This is line 4"

Or use this if you want to use cell values

Dim cell As Range
Dim strbody As String
For Each cell In Sheets("Sheet1").Range("C1:C20")
    strbody = strbody & cell.Value & vbNewLine
Next

Or this one

Dim strbody As String
With Sheets("Sheet1")
    strbody = "Hi there" & vbNewLine & vbNewLine & _
        .Range("A1") & vbNewLine & _
        .Range("A2") & vbNewLine & _
        .Range("A3") & vbNewLine & _
        .Range("A4")
End With



Links

.TextBody = "file://Yourcomputer/YourFolder/Week2.xls"

'If there are spaces use %20
.TextBody = "file://Yourcomputer/YourFolder/Week%202.xls"

'Example for a file on a website
.TextBody = "http://www.rondebruin.nl/files/EasyFilter.zip"



HTML text :

If you want to create emails that are formatted you can use HTMLBody (Office 2000 and up) instead of TextBody. You can find a lot of WebPages on the internet with more HTML tags examples.

.HTMLBody = "

Dear Ron de Bruin

" & _
"Please visit this website to download an update.
" & _
"Ron's Excel Page"


Tip: Or send a complete webpage, instead of HTMLBody or TextBody use

.CreateMHTMLBody "http://www.rondebruin.nl/copy1.htm"

Or file on your computer
.CreateMHTMLBody "file://C:/test.htm"



Copy the cells as values

If you want to paste as values the sheet must be unprotected!!!!!
Or Unprotect and Protect the sheet in the Sub also.

See this page for example code that you can use
http://www.rondebruin.nl/values.htm



Test if you are online

You can use code like this in your subroutine to avoid errors if you run the code
when you are not online (example below is for a dial up connection)

For checking other connections check out this great website.
http://vbnet.mvps.org/

Public Declare Function InternetGetConnectedState _
                         Lib "wininet.dll" (lpdwFlags As Long, _
                                            ByVal dwReserved As Long) As Boolean

Function IsConnected() As Boolean
    Dim Stat As Long
    IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
End Function

Sub Test()
' Randy Birch
    If IsConnected = True Then
        MsgBox "Copy your mail code here"
    Else
        MsgBox "You can't use this subroutine because you are not online"
    End If
End Sub

Links to more information about CDO for windows 2000


MSDN
Search for "CDO for Windows 2000" on MSDN

Paul R. Sadowski
http://www.paulsadowski.com/WSH/cdo.htm

www.aspfaq.com
http://www.aspfaq.com/show.asp?id=2026

http://www.rondebruin.nl/cdo.htm

How to Perform a Break-Even Analysis

How many units of stuff—say, how many ham sandwiches, iPhone apps, or hours of consulting services—must you sell in order to cover your costs?

A break-even analysis is a key part of any good business plan. It can also be helpful even before you decide to write a business plan, when you're trying to figure out if an idea is worth pursuing. Long after your company is up and running, it can remain helpful as a way to figure out the best pricing structure for your products.

It sounds complicated, but it's not. Basically, a break-even analysis lets you know how many units of stuff—say, how many ham sandwiches, iPhone apps, or hours of consulting services—you must sell in order to cover your costs.

You'll need several basic pieces of information:
• Fixed costs per month
• Variable costs per unit
• Average price per unit

Performing a Break-Even Analysis: Fixed Costs
Fixed costs are ones like rent and administrative payroll that don't change much from month to month, regardless of how many units you sell. SCORE lists many common fixed costs.

"Be sure to include everything," says Jerry Chautin, a volunteer SCORE business mentor in Atlanta and Sarasota, Florida. "People forget about things like deposits or contingency funds, which can add up to a sizable amount."

If you're creating a business from scratch, don't rely on guesswork to estimate your costs. Chautin suggests asking the utility company for the past year of bills for your location. Call an insurance broker for a real quote for your particular business. Check with trade associations or web sites such as www.bizstats.com for information on average costs in your particular industry.

Performing a Break-Even Analysis: Variable Costs

Variable costs are ones like inventory, shipping and sales commissions that rise or fall with your sales volume. As with fixed costs, talk to trade associations, vendors and even other business owners in your field to come up with the most accurate estimate.

"Look up the financials of public companies in your industry: 10-Ks, which are annual disclosures, or 10-Qs, which are quarterly," Chautin says. "Even though those companies are much larger, you can size it down. The ratios are not going to be that far off."

Performing a Break-Even Analysis: Pricing

This is the trickiest of your three pieces of data, since you're able to choose exactly where to set your prices. Start by looking at your competition, and how they price their products. You can also do informal focus groups to see what people might be willing to pay for your wares or services.

"You can look at pricing many different ways," says Gwendolyn Wright, a small business coach with The Wright Consultants in San Francisco. "How's your competition pricing it? Do you want to be at the midpoint, higher end, or lower end? I see people pricing earrings at three times what their competitors are charging. Why would anyone buy that?"

You'll also need to consider your costs when setting prices. If you spend $2 on meat and condiments to produce a hamburger, you'll obviously need to price it at more than $2. But how much more—$4? $5? $7? That's where a break-even analysis can come in handy.

Performing a Break-Even Analysis: The Formula

Once you've got your cost data and a target price, plug them in to this formula:

BEQ = Fixed costs / (Average price per unit – average cost per unit)

This will tell you your break-even quantity (BEQ), the number of units you need to sell to cover your costs. Any sales above that are pure profit. Anything below means you're losing money.

Here's an example. Suppose you're turning a jewelry-making hobby into a business. You have $1,000 per month of fixed costs (studio rent, utilities, equipment, etc.). Your variable costs for each necklace are $50 for materials and labor. You'd like to charge $70 per necklace, since that's what similar pieces are selling for.

BEQ = $1000 / ($70 – $50) = $1000 / $20 = 50

That means you'd need to sell 50 necklaces a month at $70 each in order to break even.

Use your break-even formula to compare different pricing strategies. For instance, if you raised the price to $80, you'd only need to sell 33 necklaces—but it might be harder to attract buyers.

On the other hand, if you lowered the price to $60, you'd attract bargain shoppers—but would need to sell 100 necklaces to break even.

The break-even formula can help you compare different cost structures as well as prices. For instance, suppose you used less expensive materials in your necklaces and pared the unit cost down to $45. The formula tells you that you'd have to sell just 66 necklaces at $60 to break even.

You can use a basic Excel spreadsheet to run different break-even scenarios, or download one of many break-even templates available online.

http://www.inc.com/guides/2010/12/how-to-perform-a-break-even-analysis.html

Excel Tip: Count the Number of Occurrences of a Single Character in One Cell

I am currently helping a partner with a conversion from QuickBooks to Dynamics GP--specifically to migrate QuickBooks transaction Class data into GP Analytical Accounting transactions. For various reasons, standard, and even non-standard migration tools have been unable to convert the QuickBooks data, so we've been forced to export the data and import it into GP.

The eConnect integration I developed works great, but one of the annoyances has been preparing a QuickBooks export file for import to GP. If you are familiar with QuickBooks exports, you know that when data is exported to Excel, it typically looks quite presentable, but is not exactly import-friendly.

While trying to map the QuickBooks chart of accounts to the GP chart of accounts, I had to determine how many "levels" the QuickBooks account had. So for instance, there might be Account: Sub-Account: Department: Location: Expense: Sub-Expense. Out of the pile of QB accounts, I needed to determine the maximum number of "levels" the accounts had. Since there is a colon between each level, I just needed to count the number of colons in the cell, and then add one. Simple!

But I am pretty sure I've never had to count the number of occurrences of a value in a single cell. I've used the SEARCH function to determine whether a value exists at all, but never had to count the occurrences of that value.

With Google to the rescue, I stumbled across a Microsoft Support article that provided several examples of how to count the occurrences of a string in an Excel file.

http://support.microsoft.com/kb/213889

And here is the formula for counting the number of occurrences of a character in a cell:

=LEN(cell_ref)-LEN(SUBSTITUTE(cell_ref,"a",""))

Pretty darn smart. Maybe, on a good day, with enough sleep, I could have come up with something that elegant, but I am pretty sure that article saved me alot of time.

Examples for Exporting to EXCEL Workbook Files

Create and Export a Parameter Query to EXCEL file via TransferSpreadsheet (VBA)

Create a Query and Export multiple "filtered" versions of a Query (based on data in another table) to separate EXCEL files via TransferSpreadsheet (VBA)

Create a Query and Export multiple "filtered" versions of a Query (based on data in another table) to separate Worksheets within one EXCEL file via TransferSpreadsheet (VBA)

Write Data From a Recordset into an EXCEL Worksheet using Automation (VBA)

Write Data From a Recordset into an EXCEL Worksheet using EXCEL's CopyFromRecordset (VBA)

Browse to a single EXCEL File and Export Data to that EXCEL File via TransferSpreadsheet (VBA)

Browse to a single Folder and Export Data to a New EXCEL File in that Folder via TransferSpreadsheet (VBA)

Using the Range Argument of TransferSpreadsheet when Exporting Data to an EXCEL File (VBA)

Create and Export a Parameter Query to EXCEL file via TransferSpreadsheet (VBA)

Generic code to generate "on the fly" a query that uses one or more controls on an open form as parameters, and then export that query to an EXCEL file. This example concatenates the parameter values into the generated SQL statement and then saves the query so that it can be exported. The query then is deleted after the export is completed.

Dim dbs As DAO.Database
Dim qdfTemp As DAO.QueryDef
Dim strSQL As String, strQDF As String
Set dbs = CurrentDb

' Replace NameOfTableOrQuery with the real name of the table or query,
' replace NameOfForm with the real name of the form, and replace
' ADateControlOnForm and AnotherDateControlOnForm with the real names
' of the controls on that form
strSQL = "SELECT NameOfTableOrQuery.* FROM NameOfTableOrQuery " & _
"WHERE NameOfTableOrQuery.FieldName >= " & _
Format(Forms!NameOfForm!ADateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & _
" And NameOfTableOrQuery.FieldName <=" & _
Format(Forms!NameOfForm!AnotherDateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & "';"

strQDF = "_TempQuery_"
Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)
qdfTemp.Close
Set qdfTemp = Nothing

' Replace C:\MyFolderName\MyFileName.xls with the real path and filename for the
' EXCEL file that is to contain the exported data
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strQDF,"C:\MyFolderName\MyFileName.xls"

dbs.QueryDefs.Delete strQDF
dbs.Close
Set dbs = Nothing

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Create a Query and Export multiple "filtered" versions of a Query (based on data in another table) to separate EXCEL files via TransferSpreadsheet (VBA)

Generic code to create a temporary query, get list of filtering values, and then loop through the list to filter various data and export each filtered query to separate EXCEL files. In this sample code, the employees assigned to each manager are exported to separate EXCEL files, one file for each manager.

Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False

' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"ManagerID = " & rstMgr!ManagerID.Value & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing

' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\FolderName\" & strMgr & Format(Now(), _
"ddMMMyyy_hhnn") & ".xls"
rstMgr.MoveNext
Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Create a Query and Export multiple "filtered" versions of a Query (based on data in another table) to separate Worksheets within one EXCEL file via TransferSpreadsheet (VBA)

Generic code to create a temporary query, get list of filtering values, and then loop through the list to filter various data and export each filtered query to separate EXCEL files. In this sample code, the employees assigned to each manager are exported to separate worksheets within the same EXCEL file, one worksheet for each manager.

Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String

' Replace PutEXCELFileNameHereWithoutdotxls with actual EXCEL
' filename without the .xls extension
' (for example, MyEXCELFileName, BUT NOT MyEXCELFileName.xls)
Const strFileName As String = "PutEXCELFileNameHereWithoutdotxls"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False

' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"ManagerID = " & rstMgr!ManagerID.Value & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing

' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\FolderName\" & strFileName & ".xls"
rstMgr.MoveNext
Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Write Data From a Recordset into an EXCEL Worksheet using Automation (VBA)

Generic code to open a recordset for the data that are to be written into a worksheet in an EXCEL file (for this example, the EXCEL file must already exist, and the worksheet must already exist in the EXCEL file), and then to loop through the recordset and write each field's value into a cell in the worksheet, with each record being written into a separate row in the worksheet. The starting cell for the EXCEL worksheet is specified in the code; after that, the data are written into contiguous cells and rows. This code example uses "late binding" for the EXCEL automation.

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")

' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets("WorksheetName")

' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)

If rst.EOF = False And rst.BOF = False Then

rst.MoveFirst

If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1,0)
End If

' write data to worksheet
Do While rst.EOF = False
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1,0)
Loop

End If

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Write Data From a Recordset into an EXCEL Worksheet using EXCEL's CopyFromRecordset (VBA)

Generic code to open a recordset for the data that are to be written into a worksheet in an EXCEL file (for this example, the EXCEL file does not already exist), and then to use EXCEL's CopyFromRecordset method to copy the data from the recordset into the first worksheet in that EXCEL file, with each record being written into a separate row in the worksheet. The code allows for a header row to be created in the worksheet if this is desired. This code example uses "late binding" for the EXCEL automation.

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strPathFileName As String, strWorksheetName As String
Dim strRecordsetDataSource As String
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

' Replace C:\Filename.xls with the actual path and filename
' that will be used to save the new EXCEL file into which you
' will write the data
strPathFileName = "C:\Filename.xls"

' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
strRecordsetDataSource = "QueryOrTableName"

' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True

' Create a new EXCEL workbook
Set xlw = xlx.Workbooks.Add

' Rename the first worksheet in the EXCEL file to be the first 31
' characters of the string in the strRecordsetDataSource variable
Set xls = xlw.Worksheets(1)
xls.Name = Trim(Left(strRecordsetDataSource, 31))

' Replace A1 with the cell reference of the first cell into which the
' headers will be written (blnHeaderRow = True), or into which the data
' values will be written (blnHeaderRow = False)
Set xlc = xls.Range("A1")

Set dbs = CurrentDb()

Set rst = dbs.OpenRecordset(strRecordsetDataSource, dbOpenDynaset, dbReadOnly)

If rst.EOF = False And rst.BOF = False Then
' Write the header row to worksheet
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1,0)
End If

' copy the recordset's data to worksheet
xlc.CopyFromRecordset rst
End If

rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing

' Save and close the EXCEL file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.SaveAs strPathFileName
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Browse to a single EXCEL File and Export Data to that EXCEL File via TransferSpreadsheet (VBA)

Generic code to browse to a single EXCEL file, and then to export the data to that EXCEL file. This generic method uses the Windows API to browse to a single file the code for this API (which was written by Ken Getz) is located at The ACCESS Web ( www.mvps.org/access ).

First step is to paste all the Getz code (from http://www.mvps.org/access/api/api0001.htm ) into a new, regular module in your database. Be sure to give the module a unique name (i.e., it cannot have the same name as any other module, any other function, or any other subroutine in the database). Then use this generic code to allow the user to select the EXCEL file to which the data are to be exported.

Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean

strBrowseMsg = "Select the EXCEL file:"

' Change C:\MyFolder\ to the path for the folder where the Browse
' window is to start (the initial directory). If you want to start in
' ACCESS' default folder, delete C:\MyFolder\ from the code line,
' leaving an empty string as the value being set as the initial
' directory
strInitialDirectory = "C:\MyFolder\"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")

strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)

If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If

' Replace tablename with the real name of the table from which
' the data are to be exported
strTable = "tablename"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTable, strPathFile

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Browse to a single Folder and Export Data to a New EXCEL File in that Folder via TransferSpreadsheet (VBA)

Generic code to browse to a single folder, and then to import the data from the first (or only) worksheet in all EXCEL files that are located within that folder. All of the EXCEL files' worksheets must have the data in the same layout and format. This generic method uses the Windows API to browse to a single folder; the code for this API (which was written by Terry Kreft) is located at The ACCESS Web ( www.mvps.org/access ).

First step is to paste all the Kreft code (from http://www.mvps.org/access/api/api0002.htm ) into a new, regular module in your database. Be sure to give the module a unique name (i.e., it cannot have the same name as any other module, any other function, or any other subroutine in the database). Then use this generic code to allow the user to select the folder in which the EXCEL files are located.

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg As String
Dim blnHasFieldNames As Boolean

strBrowseMsg = "Select the folder where the new EXCEL file will be created:"

strPath = BrowseFolder(strBrowseMsg)

If strPath = "" Then
MsgBox "No folder was selected.", vbOK, "No Selection"
Exit Sub
End If

' Replace filename.xls with the real name of the EXCEL file
' that is to be created and into which the data are to be
' exported
strFile = "filename.xls"

' Replace tablename with the real name of the table from which
' the data are to be exported
strTable = "tablename"

strPathFile = strPath & "\" & strFile

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTable, strPathFile

Return to Top of Page

Return to EXCEL Main Page

Return to Home

Using the Range Argument of TransferSpreadsheet when Exporting Data to an EXCEL File (VBA)

After I read many posts in the newgroups about using the Range argument for exporting queries/tables to EXCEL file, I decided to do some testing to figure out what actually works and what doesn't work when using this argument (NOTE that the use of the Range argument for exports is an UNDOCUMENTED feature in ACCESS).

Here are the results of my tests for your information and entertainment. My tests were done with ACCESS 2003 and EXCEL 2003.

EXCEL FILE DOES NOT ALREADY EXIST
---------------------------------------------------------------

If the EXCEL file will be created by TransferSpreadsheet, the Range argument
can be used to create a range in the new file that describes the cells that
contain the exported data on the worksheet. This Range argument also is used
to name the worksheet onto which the exported data are written. This
overrides the normal operation of TransferSpreadsheet, which is to name the
worksheet using the name of the table or query being exported. For example,
this action:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"QueryName","C:\Test.xls",, "MyName"

will create the file "C:\Test.xls" and the data will be written onto the
first worksheet, which will be named MyName (the Worksheet.Name property,
not the Worksheet.CodeName property); and the cells into which the data are
written will be a Range named MyName in the new file. This range will
include the field names that are exported as the first row of data, and the
range will begin in cell A1.



EXCEL FILE ALREADY EXISTS
------------------------------------------------

The Range argument can be used to identify the actual Range into which the
exported data are written. TransferSpreadsheet ignores worksheet names when
looking for the Range in the workbook file. It looks specifically for a
defined Range of cells.

However, it is in this situation where I believe many posters have run into
problems with this undocumented feature.

1) If the Range exists (cell range, that is) AND if that range encompasses
more than a single cell (at least two cells), the data are exported to that
range of cells. If the number of records and/or fields are more or fewer
than the "size" of the range (number of rows and columns), the data are
correctly exported and the Range is redefined to match the size of the
exported data in terms of width and depth of the range (number of rows and
number of columns). Note that any formatting in the cells within this range
is retained (e.g., Bold, Highlight color, font color, etc.).


2) If the Range does not exist in the workbook file, TransferSpreadsheet
creates a new worksheet, names it with the Range argument value, writes the
data onto that worksheet, and creates a new Range (also named with the Range
argument value) to define the cells that contain the exported data. If a
worksheet with the same name as what is in the Range argument already exists
in the workbook file, the new worksheet that is created is named using
standard EXCEL process, namely, the Range argument name followed by a 1.
Thus, if I use MyName as the Range argument and export to an existing file,
I can get one of the following results:

a) File already contains a worksheet named MyName but does not
contain a Range named MyName: A new worksheet named MyName1 is created, the
data are written onto that worksheet, and a new Range named MyName is
defined for the cells that received those exported data.

b) File does not contain a worksheet named MyName and does not
contain a Range named MyName: A new worksheet named MyName is created, the
data are written onto that worksheet, and a new Range named MyName is
defined for the cells that received those exported data.


3) If the Range exists (cell range, that is) AND if the Range consists of
a single cell (e.g., A1), then strange things happen -- note that it doesn't
matter if the Range starts in cell A1 or not. And because of these strange
things, this is where the feature is unusable for exporting. I haven't
defined exact "rules" to describe what happens (although it appears that how
far the range is moved appears to be "the original row number plus 93"
columns (if the Range was originally in column A), but here are my
observations in this situation (I won't guarantee that you won't see
different behaviors):

a) If the worksheet name is the same name as the Range name, and
the Range begins in cell A1, the exported data are written to the worksheet
that contains the Range specified in the TransferSpreadsheet action, and
these data begin at cell A1 (with the field names row) -- BUT the existing
range is moved to cell CQ1 (94 columns to the right), and there is no Range
created for the cells that contain the exported data. Any further attempt to
export to this worksheet using the same Range argument generates an error
because the "move" of the range will extend beyond the column limit of the
worksheet.

b) If the worksheet name is the same name as the Range name, and
the Range begins in cell A5, the exported data are written to the worksheet
that contains the Range specified in the TransferSpreadsheet action, and
these data begin at cell E5 (with the field names row) -- BUT the existing
range is moved to cell CU5 (98 columns to the right), and there is no Range
created for the cells that contain the exported data. Any further attempt to
export to this worksheet using the same Range argument generates an error
because the "move" of the range will extend beyond the column limit of the
worksheet.

c) If the worksheet name is not the same as the Range name, and
the Range begins in cell A1, the exported data are written to a new
worksheet that is named the same as the Range argument value, and the
existing Range is then moved to cell IV1 (the last column in the sheet) on
that new worksheet, and there is no Range created for the cells that contain
the exported data.

http://www.accessmvp.com/KDSnell/EXCEL_Export.htm

VBA function to count # of days between two dates

Function DayCount(DateBeg As Date, DateEnd As Date, Optional D1 As Integer, Optional D2 As Integer, Optional D3 As Integer, Optional D4 As Integer, Optional D5 As Integer, Optional D6 As Integer, Optional D7 As Integer)
For i = 0 To DateEnd - DateBeg If Weekday(DateBeg + i) = D1 Then Cnt = Cnt + 1 Else End If
If Weekday(DateBeg + i) = D2 Then Cnt = Cnt + 1 Else End If
If Weekday(DateBeg + i) = D3 Then Cnt = Cnt + 1 Else End If
If Weekday(DateBeg + i) = D4 Then Cnt = Cnt + 1 Else End If
If Weekday(DateBeg + i) = D5 Then Cnt = Cnt + 1 Else End If
If Weekday(DateBeg + i) = D6 Then Cnt = Cnt + 1 Else End If
If Weekday(DateBeg + i) = D7 Then Cnt = Cnt + 1 Else End If
Next i
DayCount = Cnt
End Function

A Better NETWORKDAYS

A Better NETWORKDAYS

The following formula does everything that the traditional NETWORKDAYS function does, plus it allows you to select as many days of the week as you want to exclude from the calculations. There are two flavors of the formula. The first version does not allow a list of holidays to exclude from the count. The second version does allow a list of holidays to exclude. Both formulas require a range named ExcludeDaysOfWeek that lists the day of week numbers (1 = Sunday, 2 = Monday, ... 7 = Saturday) to exclude from the calculation.

Formula Without Holidays

=SUM(IF(ISERROR(MATCH(WEEKDAY(ROW(INDIRECT(StartDate&":"&EndDate))),ExcludeDaysOfWeek,0)),1,0))

In this formula, StartDate is the data at which counting will begin. EndDate is the last date of the period to count. ExcludeDaysOfWeek is a range of up to 7 cells indicating the day-of-week numbers (1 = Sunday, 2 = Monday, ... 7 = Saturday) to exclude from the count. You may, if you choose to, replace the range reference of ExcludeDaysOfWeek to a hard-coded list of day numbers. For example,

=SUM(IF(ISERROR(MATCH(WEEKDAY(ROW(INDIRECT(StartDate&":"&EndDate))),{1,6,7},0)),1,0))

Note that the days of the week are enclosed in curly braces { }, not parentheses.

Formula Supports Holidays

The formula below works must like the previous formula except that it allows you to enter holidays in a range of cells, and those holidays will be excluded from the count. You must create a named range of cells named Holidays that lists the list of holidays to exclude from the result.

=IF(OR(StartDate<=0,EndDate<=0,StartDate>EndDate,ISNUMBER(StartDate)=FALSE,
ISNUMBER(EndDate)=FALSE),NA(),SUM(IF(ISERROR(MATCH(WEEKDAY(ROW(INDIRECT(StartDate&":"&EndDate))),
ExcludeDaysOfWeek,0)),IF(ISERROR(MATCH(ROW(INDIRECT(StartDate&":"&EndDate)),Holidays,0)),1,0)),0))

The formula is split into multiple lines here for the sake of readability. In practice, though, the entire formula should be on a single line. The parameters in this formula have the same meaning as they did in the previous formula, with the addition of the Holidays list. Holidays should be a range of cells that contains dates to exclude from the count. It does not matter if a holiday falls on a day of week that is listed in the ExcludeDaysOfWeek.