VB code that gets a cell value from an excel file
VB code that gets a cell value from an excel file
(OP)
I am looking for the code to be able to get a value from a cell A10 in an excel file of name data.xls and assign it to the variable name count
Anyone have a sugguestion?
Anyone have a sugguestion?






RE: VB code that gets a cell value from an excel file
Ken
CODE
'You'll need to add this Reference:
' Microsoft Excel X.X Object Library
Dim xlApp As Excel.Application
Dim bExcelWasOpen As Boolean
' Windows API for the Open Filebox
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
' structure needed by Windows API
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' for more information on Open- or SaveAs dialogs look at
' http://www.mvps.org/vbnet/index.html?code/comdlg/filedlgsoverview.htm
Public Function OpenFileDialog() As String
' common dialog for browse for desired filename
'set variables for OPENFILENAME type
Dim OFName As OPENFILENAME
'Set the filter
OFName.lpstrFilter = "Excel Files (*.xls)" + Chr$(0) + "*.xls" + Chr$(0)
'default extension
OFName.lpstrDefExt = "" + Chr$(0)
'Set the initial directory
'OFName.lpstrInitialDir = ""
OFName.lpstrInitialDir = TargetPathOnly
'Set the dialog title
OFName.lpstrTitle = "Select file"
'Set the structure size
OFName.lStructSize = Len(OFName)
'Create a buffer
OFName.lpstrFile = Space$(254)
'Set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'Set the maximum number of chars
OFName.nMaxFileTitle = 255
'no extra flags
OFName.flags = 0
'Show the 'Open File'-dialog
If GetOpenFileName(OFName) Then
OpenFileDialog = Trim$(OFName.lpstrFile)
Else
OpenFileDialog = ""
End If
If (Asc(Right(OpenFileDialog, 1)) = 0) Then
OpenFileDialog = Left$(OpenFileDialog, (Len(OpenFileDialog) - 1))
End If
End Function
Sub LoadExcel()
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If (Err = 0) Then
bExcelWasOpen = True
Else
Set xlApp = CreateObject("Excel.Application")
bExcelWasOpen = False
End If
Err.Clear 'Clear Any Errors
On Error GoTo 0
If xlApp Is Nothing Then
MsgBox "Unable to connect to Excel. Routine ending."
End
End If
xlApp.ScreenUpdating = True
xlApp.Visible = True
End Sub
Sub UnloadExcel()
If bExcelWasOpen Then
'nothing
Else
Call xlApp.Quit
End If
Set xlApp = Nothing
End Sub
Sub main()
Dim swApp As SldWorks.SldWorks
Dim sOpenFileName As String
Dim xlWkbk As Excel.Workbook
Dim count As String
Dim sSheetName As String
Dim sRow As String
Dim sCol As String
Dim dRow As Double
Dim dCol As Double
Set swApp = Application.SldWorks
sOpenFileName = OpenFileDialog()
Call LoadExcel
Set xlWkbk = xlApp.Workbooks.Open(sOpenFileName)
sSheetName = "Sheet1"
'For "A10" formatting
sRow = "10"
sCol = "A"
count = xlWkbk.Worksheets(sSheetName).Range(sCol & sRow).Value
'Debug.Print count
'For "(1,10)" formatting
' dRow = 10
' dCol = 1
' count = xlWkbk.Worksheets(sSheetName).Cells(dRow, dCol).Value
'Debug.Print count
xlWkbk.Close
Set xlWkbk = Nothing
Call UnloadExcel
swApp.Visible = True
End Sub