shanesuzanne
New Member
- Joined
- Dec 1, 2016
- Messages
- 21
I have pieced together code that emails an excel spreadsheet as an attachment from Access, using a non-Outlook email client.
The file may or may not already be open, and it is password protected. I have the code working to see if a specific file is open in Excel (I only want 1 instance of this file open). What I can't get working is that if the file is already open, to make that the Active workbook for further action (running a macro that emails the file to email addresses in the file in the email tab). There may be multiple files open on the users machine - I want it to look for a specific one - no user prompts or changing of the file name is necessary.
I'm pasting all parts of my code, so once I get it working it can be used of benefit to others.
********************************************************
Excel macro code (works good):
Sub emailAsAttachment()
Dim wkbk As Object
Dim wkst As Worksheet
Dim lastRow As Long
Set wkbk = ActiveWorkbook
Set wkst = Worksheets("email")
wkst.Visible = True
wkst.Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'the email addresses are in the sheet called "email", in column A - this loops through each email in that tab and emails this spreadsheet as an attachment
For Each c In wkst.Range("A2:A" & lastRow)
If c.Value <> "" Then
distList = c
End If
wkbk.SendMail Recipients:=distList
wkst.Visible = False
Next c
End Sub
Access IsFileOpen code (works good):
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Here is my ACCESS code that I need help with:
Sub cmdRates_Click()
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
If Not IsFileOpen("G:\Finance\Rates.xlsm") Then
Workbooks.Open "G:\Finance\Rates.xlsm", , , , "12345"
Else
'this is the code that errors out - I need it to activate the workbook that is already open
xlApp.Workbooks("Rates.xlsm").Activate
End If
'runs the macro emailAsAttachment from the file above
xlApp.Run "emailAsAttachment"
'cleanup
Set xlApp = Nothing
Set xlWb = Nothing
End Sub
****************************************************************
Thanks in advance for your time and help!
The file may or may not already be open, and it is password protected. I have the code working to see if a specific file is open in Excel (I only want 1 instance of this file open). What I can't get working is that if the file is already open, to make that the Active workbook for further action (running a macro that emails the file to email addresses in the file in the email tab). There may be multiple files open on the users machine - I want it to look for a specific one - no user prompts or changing of the file name is necessary.
I'm pasting all parts of my code, so once I get it working it can be used of benefit to others.
********************************************************
Excel macro code (works good):
Sub emailAsAttachment()
Dim wkbk As Object
Dim wkst As Worksheet
Dim lastRow As Long
Set wkbk = ActiveWorkbook
Set wkst = Worksheets("email")
wkst.Visible = True
wkst.Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'the email addresses are in the sheet called "email", in column A - this loops through each email in that tab and emails this spreadsheet as an attachment
For Each c In wkst.Range("A2:A" & lastRow)
If c.Value <> "" Then
distList = c
End If
wkbk.SendMail Recipients:=distList
wkst.Visible = False
Next c
End Sub
Access IsFileOpen code (works good):
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Here is my ACCESS code that I need help with:
Sub cmdRates_Click()
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
If Not IsFileOpen("G:\Finance\Rates.xlsm") Then
Workbooks.Open "G:\Finance\Rates.xlsm", , , , "12345"
Else
'this is the code that errors out - I need it to activate the workbook that is already open
xlApp.Workbooks("Rates.xlsm").Activate
End If
'runs the macro emailAsAttachment from the file above
xlApp.Run "emailAsAttachment"
'cleanup
Set xlApp = Nothing
Set xlWb = Nothing
End Sub
****************************************************************
Thanks in advance for your time and help!