How can I open an Excel Workbook from an Outlook macro and activate
that workbook?
The goal is to enter a 4 digit number in an outlook userform
(txtbox1), press a search button and the outlook macro should open an
excel workbook (or if excel is already running, activate excel and
open the specific workbook in a specific folder if it's not already
opened, if the workbook is already opened, activate that workbook).
Once the right workbook has been activated, go to sheet1 and search
only from cell C11 to the last occupied cell in column C, if theh
number is found, retrieve the corresponding data in column A, B, C, D,
E & F into the outlook userform txtbox2, txtbox3, txtbox4, txtbox5 &
txtbox6. Close the workbook ONLY if the outlook macro opened it.
First, a macro should never ever "activate" anything; that's what users do.
The following code might provide a starting point; the transfer of values
from and to the Outlook userform and further error checking is left as an
exercise for the reader.
Note: I posted the code unwrapped, but your reader may well wrap it again.
--
Michael Bednarek, Brisbane
http://mbednarek.com/ "POST NO BILLS"
========== cut here ==========
Option Explicit
Sub GetFromExcel(strSearch As String, strColsAtoF() As String)
' Response by Michael Bednarek to a problem from Damil4real in microsoft.public.excel (24-Jan-2010)
' Message-ID: <262d7409-32e7-43d0-83d3-22a4701f89fd@v17g2000prc.googlegroups.com>
Dim lngLower As Long
Dim lngUpper As Long
Dim blnCreated As Boolean
Dim blnOpened As Boolean
Dim appExcel As Excel.Application
Dim wksSheet As Excel.Worksheet
Dim rngFound As Excel.Range
Dim i As Long
Const strMYWORKBOOKDir = "C:\Temp\"
Const strMYWORKBOOKName = "MyWorkbook.xls"
lngLower = LBound(strColsAtoF)
lngUpper = UBound(strColsAtoF)
If lngUpper - lngLower < 5 Then
MsgBox "Only " & lngUpper - lngLower + 1 & "elements passed; need six.", vbOKOnly + vbCritical, "GetFromExcel"
Exit Sub
End If
blnCreated = False
blnOpened = False
On Error Resume Next
Set appExcel = GetObject(, "Excel.Application")
Err.Clear
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
blnCreated = True
End If
If Not WorkbookIsOpen(appExcel, strMYWORKBOOKName) Then
appExcel.Workbooks.Open FileName:=strMYWORKBOOKDir & strMYWORKBOOKName, ReadOnly:=True
blnOpened = True
End If
Set wksSheet = appExcel.Workbooks(strMYWORKBOOKName).Worksheets("Sheet1")
Set rngFound = wksSheet.Range("C11", wksSheet.Range("C11").End(xlDown)).Find(strSearch, LookIn:=xlValues)
If Not rngFound Is Nothing Then
For i = lngLower - 1 To lngUpper
strColsAtoF(lngLower + i) = rngFound.Offset(0, i - 2)
Next i
Else
For i = lngLower - 1 To lngUpper
strColsAtoF(lngLower + i) = "NOT FOUND"
Next i
End If
If blnOpened Then appExcel.Workbooks(strMYWORKBOOKName).Close savechanges:=False
If blnCreated Then appExcel.Quit
End Sub
Sub testGetFromExcel()
Dim strColsAtoF(1 To 6) As String
Call GetFromExcel("1234", strColsAtoF)
Debug.Print strColsAtoF(1), strColsAtoF(2), strColsAtoF(3), strColsAtoF(4), strColsAtoF(5), strColsAtoF(6)
End Sub
Function WorkbookIsOpen(appExcel As Excel.Application, strBookName As String) As Boolean
Dim wbkBook As Workbook
Dim strTemp As String
strTemp = UCase(strBookName)
For Each wbkBook In appExcel.Workbooks
If UCase(wbkBook.Name) = strTemp Then
WorkbookIsOpen = True
Exit Function
End If
Next wbkBook
WorkbookIsOpen = False
End Function
