Import Single Cells from Excel

Not sure why I am unable to isolate and pick one cell. Anyone see what I'm doing wrong here? I attached screen shots of the error I'm getting.
Public Function TestExcel()
Dim x
  x = fExcelCellADO("C1", "\\pacper.local\PPI Share\ProductionShopFloor\client\TESTING\ZR0040911.xls", "Inputs!")
  MsgBox x
End Function


Function fExcelCellADO(strCell As String, strFileName As String, strSheetName As String)
   
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
             & "Data Source=" & strFileName & ";" _
             & "Extended Properties='Excel 8.0;HDR=No;IMEX=1';"
             
    Set rs = New ADODB.Recordset
    'rs.Open "SELECT F1 FROM [" & strSheetName & "$" & strCell & ":" & strCell & "]", cn
    rs.Open "SELECT F1 FROM [" & strSheetName & strCell & "]", cn
    fExcelCellADO = rs!f1
 
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
 
End Function

Open in new window

VBAError.doc
Eileen MurphyIndependent Application DeveloperAsked:
Who is Participating?
 
Eileen MurphyConnect With a Mentor Independent Application DeveloperAuthor Commented:
Oooops I forgot to take the "!" out of the sheet name. When I removed it it worked!!!!

Thanks a lot folks!
0
 
Rey Obrero (Capricorn1)Connect With a Mentor Commented:
try this revised function


Function fExcelCell (strCell As String, strFileName As String, strSheetName As String)
   
    Dim xlObj as object
      set  xlObj=createobject("excel.application")
                            xlobj.workbooks.open strFileName
                  fExcelCell= xlObj .Worksheets(strSheetName).Range(strCell).value

      xlobj.quit
                   set xlObj=nothing
end function
0
 
Rey Obrero (Capricorn1)Commented:

test this codes
Public Function TestExcel()
Dim x
  x = fExcelCell("C1", "\\pacper.local\PPI Share\ProductionShopFloor\client\TESTING\ZR0040911.xls", "Inputs!")
  MsgBox x
End Function

Function fExcelCell(strCell As String, strFileName As String, strSheetName As String)
   
Dim xlObj As Object
    Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open strFileName
    fExcelCell = xlObj.Worksheets(strSheetName).Range(strCell).Value

xlObj.Quit
Set xlObj = Nothing
End Function

Open in new window

0
Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

 
Rey Obrero (Capricorn1)Commented:
change this

  x = fExcelCell("C1", "\\pacper.local\PPI Share\ProductionShopFloor\client\TESTING\ZR0040911.xls", "Inputs!")

with

  x = fExcelCell("C1", "\\pacper.local\PPI Share\ProductionShopFloor\client\TESTING\ZR0040911.xls", "Inputs")

remove the bang sign from  "Inputs!"
0
 
Eileen MurphyIndependent Application DeveloperAuthor Commented:
Subscript Out of Range

-->>  fExcelCell= xlObj .Worksheets(strSheetName).Range(strCell).value

0
 
Rey Obrero (Capricorn1)Commented:
this line is errorneous

---------------------v------ remove the space between xlObj and the dot
 fExcelCell= xlObj .Worksheets(strSheetName).Range(strCell).value


copy these codes


Public Function TestExcel()
Dim x
  x = fExcelCell("C1", "\\pacper.local\PPI Share\ProductionShopFloor\client\TESTING\ZR0040911.xls", "Inputs")
  MsgBox x
End Function

Function fExcelCell(strCell As String, strFileName As String, strSheetName As String)
   
Dim xlObj As Object
    Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open strFileName
    fExcelCell = xlObj.Worksheets(strSheetName).Range(strCell).Value

xlObj.Quit
Set xlObj = Nothing
End Function

Open in new window



0
 
Eileen MurphyIndependent Application DeveloperAuthor Commented:
Strange -- same error... and regarding your previous comment --- there was no space -- odd.
0
 
Eileen MurphyIndependent Application DeveloperAuthor Commented:
I tried this - added the exclamation point - still no good.

 x = fExcelCell("C1", "\\pacper.local\PPI Share\ProductionShopFloor\client\TESTING\ZR0040911.xls", "Inputs!")

I'm going to import the spreadsheet instead of having it linked to check the field types.
0
 
Rey Obrero (Capricorn1)Commented:
can you post the codes that you are USING..
0
 
Rey Obrero (Capricorn1)Commented:
tr y this change, you should see the excel file Open

also take note that the path you are passing has a { dot }  on this part  "\\pacper.local\

Function fExcelCell(strCell As String, strFileName As String, strSheetName As String)
   
Dim xlObj As Object
    Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open strFileName

    xlObj.visible= true

Stop

    fExcelCell = xlObj.Worksheets(strSheetName).Range(strCell).Value

xlObj.Quit
Set xlObj = Nothing
End Function
0
 
Eileen MurphyIndependent Application DeveloperAuthor Commented:
Same -- Subscript out of range. I researched the error

It said that it is because the column has multiple data types -- which is true. This spreadsheet doesn't use column headings -- have tons of formulas, etc. So the individual cells need to be access as opposed to importing an entire sheet.

If I import the spreadsheet I can probably query the fields that way based on an autonumber record ID

0
 
Rey Obrero (Capricorn1)Commented:
upload a copy of the excel file...
0
 
Eileen MurphyIndependent Application DeveloperAuthor Commented:
Thanks a lot!!!!
0
 
Eileen MurphyIndependent Application DeveloperAuthor Commented:
I didn't award the points properly -- Capricorn should get the "solution"

Sorry.
0
 
Rey Obrero (Capricorn1)Commented:
if you are just reading the posts before acting on your own, it would have been done from this post

http:#a36504175

http:#a36504237 
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.