New to Outlook VBA what are my choices if I want Outlook to look into an Excel file's A column for a value and return the B column value? (Same as a VLOOKUP)
Option Explicit
Sub LookUpExcel()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim ExcelFileName As String
Dim ColumnA As String
Dim ColumnB As String
Dim oMsg As MailItem
ExcelFileName = "C:\Users\vfdme\Desktop\test.xlsx"
Set exWb = objExcel.Workbooks.Open(ExcelFileName)
ColumnA = InputBox("Please Column A value.")
'[VLOOKUP / Search function?]
MsgBox (ColumnB)
ExitRoutine:
Set oMsg = Nothing
Set exWb = Nothing
Set objExcel = Nothing
End Sub
Got the code to work properly :)
Thanks #braX for the tip.
Sub LookUpExcel()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim ExcelFileName As String
Dim ColumnA As String
Dim ColumnB As String
Dim oMsg As MailItem
ExcelFileName = "C:\Filelocation\Testfile.xlsx"
Set exWb = objExcel.Workbooks.Add(ExcelFileName)
ColumnA = InputBox("Please Column A value.")
ColumnB = exWb.Worksheets("Sheet1").Range("A:A").Find(ColumnA).Offset(0, 1).Value
msgbox (ColumnB)
ExitRoutine:
Set oMsg = Nothing
Set exWb = Nothing
Set objExcel = Nothing
End Sub
Related
I'm struggling trying to export a Word table to an Excel sheet, while preserving the number formatting. My code works as shown below, but the part I commented out is how I'm currently trying to do it (and failing). Could someone point out what I'm doing wrong?
Public Sub CopyTableToExcel()
Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim doc As Word.Document
Dim tbl As Word.Table
Dim lastRow As Long, lastColumn As Integer
Dim tblRange As Word.Range
Dim excelRange As Excel.Range
Set doc = ThisDocument
Set xlApp = CreateObject("Excel.Application")
Set xlwb = xlApp.Workbooks.Add 'Create new workbook
Set tbl = doc.Tables(2)
With tbl:
lastRow = .Rows.Count
lastColumn = .Columns.Count
Set tblRange = .Cell(1, 1).Range
tblRange.End = .Cell(lastRow, lastColumn).Range.End
tblRange.Copy
xlwb.Worksheets(1).Paste
'This part doesn't work, but I'm trying to do something like this:
'Set excelRange = xlwb.Worksheets("Sheet1").Range("A1")
'excelRange.PasteSpecial (xlPasteValuesAndNumberFormats)
End With
Set xlwb = Nothing
Set xlApp = Nothing
Set tbl = Nothing
Set doc = Nothing
End Sub
Thanks for your help!
I have the below code to get all the Sheetnames of a selected workbook. How do I get all the names of the sheets and import them into a table in the Access Database?
Public Sub PickSheets1(fileName As String)
Dim objExc As Object
Dim objWbk As Object
Dim objWsh As Object
SQLInsert = "INSERT INTO Sheets Table (Sheets) Values (objWbk.Worksheets.Name)"
Set TabInsert = CurrentDb.CreateTableDef("Sheets Table")
Set TabFields = TabInsert.CreateField("Sheets")
Set objExc = CreateObject("Excel.Application")
Set objWbk = objExc.Workbooks.Open(fileName)
Set objWsh = objWbk.Worksheets.Name
DoCmd.RunSQL SQLInsert
'For Each objWsh In objWbk.Worksheets
'TabFields("Sheets").Value objWsh.Name
Set objWsh = Nothing
objWbk.Close
Set objWbk = Nothing
objExc.Quit
Set objExc = Nothing
End Sub
So from within MSAccess you can run this code. Its uses DAO to add the sheet name to the table. Assumes that the table 'Sheets Table' with column 'SheetName' already exists.
call loadSheetNames("C:Path\Workbook.xlsx")
Function loadSheetNames(pstrWB As String)
' Access
Dim db As DAO.Database
Dim rst As DAO.Recordset
' Excel
Dim xl As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Set db = CurrentDb
Set rst = db.OpenRecordset("Sheets Table")
Set xl = CreateObject("Excel.Application")
Set xlWB = xl.Workbooks.Open(pstrWB)
For Each xlWS In xlWB.Sheets
Debug.Print xlWS.NAME
rst.AddNew
rst("SheetName") = xlWS.NAME
rst.update
Next
Set rst = Nothing
Set db = Nothing
Set xlWS = Nothing
Set xlWB = Nothing
Set xl = Nothing
End Function
If you want to run the code from within Excel, I can give you that as well.
I'm very new to VBA, but I am trying to make a program that will offer suggestions for translations when selecting and right-clicking a word in MS Word. I am getting the message "Compile-Error: Method or data member not found" in the code below at Found.Address:
Dim Current As String
Dim oSheet As Range
Dim Found As Range
Dim firstAddress As String
Dim oChanges As Worksheet
Dim sFname As String
Dim oExcel As Excel.Application
Set oExcel = New Excel.Application
oExcel.Visible = False
sFname = "C:\Users\user\Desktop\translations.xlsx"
Set oChanges = oExcel.Workbooks.Open(FileName:=sFname)
Set oSheet = ActiveSheet.UsedRange
'Prepping Excel File
Set oSheet = ActiveSheet.UsedRange
Current = Selection.Text
With oSheet
Set Found = .Find(Current)
If Not Found Is Nothing Then
firstAddress = Found.Address
Do
.................................
I copied this format directly from the Range.Find help page for VBA. What am I missing?
I am creating a macro in outlook to send an eamil with some specific information in it. But only some people from the list in an excel sheet can send that email out. When they hit "SEND" on that macro, it needs to open the excel sheet and varify if that person is listed on the list. If he isn't it should just give him an error " You are not eligible to send this message" .
I am able to open the excel file using the code below. But I am not sure how to do the checking (names are listed on Sheet1 from C1: C100) to see that sending person is listed in there.
Below is my code:
[Dim strFldr As String
Dim OutMail As Object
Dim xlApp As Object
strFldr = "C:\\users-d\gxg063\Gift\test\"
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
xlApp.Workbooks.Open strFldr & "\RegionalAuthority.xlsx"]
Let me know how this works out - you'll need a reference to Excel in your Outloook VBE
Sub TestSub()
Dim strFldr As String
Dim OutMail As Object
Dim xlApp As Excel.Application
Dim xlWb As Workbook
Dim xlWs As Worksheet
Dim r As Range
Dim User As String
Dim c As Range
strFldr = "C:\\users-d\gxg063\Gift\test\"
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strFldr & "\RegionalAuthority.xlsx")
Set xlWs = xlWb.Worksheets("Sheet1")
Set r = xlWs.Range("C1:C100")
User = (Environ$("Username"))
For Each c In r
If c = User Then
'Call your Send Macro here
Exit For
End If
Next c
xlApp.Visible = True
Set xlApp = Nothing
Set xlWb = Nothing
Set xlWs = Nothing
End Sub
I have the following code as part of my sub trying to assign a range:
'Set xlApp = CreateObject("Excel.Application")
Dim xlApp As Object
Set xlApp = GetObject(, "Excel.Application")
xlApp.Visible = False
xlApp.ScreenUpdating = False
Dim CRsFile As String
Dim CRsMaxRow As Integer
' get the CR list
CRsFile = "CRs.xls"
Set CRsWB = xlApp.Workbooks.Open("C:\Docs\" + CRsFile)
With CRsWB.Worksheets("Sheet1")
.Activate
CRsMaxRow = .Range("A1").CurrentRegion.Rows.Count
Set CRs = .Range("A2:M" & CRsMaxRow)
End With
Dim interestingFiles As Range
' get the files names that we consider interesting to track
Set FilesWB = xlApp.Workbooks.Open("files.xlsx")
With FilesWB.Worksheets("files")
.Activate
Set interestingFiles = .Range("A2:E5")
End With
Do you have any idea why am I getting a run time type mismatch error?
If you run the code from Word then the problem is in the declaration of 'interestingFiles' variable. Range exist in Word as well so use either Variant or add reference to Excel and then use Excel.Range.
Without Excel reference:
Dim interestingFiles As Variant
And with Excel reference:
Dim interestingFiles As Excel.Range
Kindly set xlApp object as in below code.
Also you provide complete path for your workbook when opening it.
Sub test()
Dim interestingFiles As Range
Dim xlApp As Object
Set xlApp = GetObject(, "Excel.Application")
' get the files names
Dim path As String
path = "C:\Users\Santosh\Desktop\file1.xlsx"
Set FilesWB = xlApp.Workbooks.Open(path)
With FilesWB.Worksheets(1)
.Activate
Set interestingFiles = .Range("A2:E5")
End With
End Sub