Solved

Import Single Cells from Excel

Posted on 2011-09-08
15
269 Views
Last Modified: 2012-05-12
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
0
Comment
Question by:Ei0914
  • 8
  • 7
15 Comments
 
LVL 120

Assisted Solution

by:Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1) earned 500 total points
ID: 36504110
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
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504157

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
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504175
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
Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

 

Author Comment

by:Ei0914
ID: 36504191
Subscript Out of Range

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

0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504237
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
 

Author Comment

by:Ei0914
ID: 36504327
Strange -- same error... and regarding your previous comment --- there was no space -- odd.
0
 

Author Comment

by:Ei0914
ID: 36504344
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
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504355
can you post the codes that you are USING..
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504379
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
 

Author Comment

by:Ei0914
ID: 36504519
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
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504535
upload a copy of the excel file...
0
 

Accepted Solution

by:
Ei0914 earned 0 total points
ID: 36504543
Oooops I forgot to take the "!" out of the sheet name. When I removed it it worked!!!!

Thanks a lot folks!
0
 

Author Closing Comment

by:Ei0914
ID: 36527913
Thanks a lot!!!!
0
 

Author Comment

by:Ei0914
ID: 36504556
I didn't award the points properly -- Capricorn should get the "solution"

Sorry.
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36504607
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

Featured Post

Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

679 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question