?
Solved

MICROSOFT ACCESS 2007/Excel 2007

Posted on 2011-09-14
11
Medium Priority
?
269 Views
Last Modified: 2012-05-12
I want to load multiple excel worksheets(5) into access table.  I only want certain excel ranges from each worksheet.   I found code to loop through the directory for the sheets but I am having problem with range properties in excel.  Here is what i have so far.

Public Function MYPREMLOAD()
    Dim strPath As String, strFolderPath As String
    Dim appExcel As Excel.Application
    Dim MyDB As DAO.Database, MyRS As DAO.Recordset
    Dim LastRow As Long
   
    DoCmd.SetWarnings False
    strsql = "Delete * From tblPolicyLoad;"
    DoCmd.RunSQL strsql
    DoCmd.SetWarnings True
 
    Set MyDB = CurrentDb()
   
    Set MyRS = MyDB.OpenRecordset("tblPolicyLoad", dbOpenDynaset)
     
   
    strFolderPath = "X:\Special Risk\miketesting\KARA\"
    strPath = "X:\Special Risk\miketesting\KARA\*.xls"
     
    strPath = Dir(strPath, vbNormal)
    Set appExcel = CreateObject("Excel.Application")
     
    Do While strPath <> ""
        appExcel.Workbooks.Open strFolderPath & strPath
        appExcel.Visible = True

       WHERE DO A PUT THE SHEETNAME I WANT TO REFERENCE?
       I ONLY WANT TO REFEERENCE THE FOLLOWING CELLS FROM EACH SHEET
       B10
       C10
       D10

        With MyRS
       

*****WHAT CODE GOES HERE





************END CODE
        End With
        strPath = Dir
    Loop
     
    appExcel.Quit
    Set appExcel = Nothing
    'appExcel.ActiveWorkbook.Close
    MyRS.Close
    Set MyRS = Nothing
0
Comment
Question by:centralmike
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 4
11 Comments
 
LVL 16

Expert Comment

by:carsRST
ID: 36537560
If you know the name of the sheet, you could do something like this within your code



Dim rng As Range
Set rng = Activeworkbook.sheets("...name of sheet...").Range("B10:D10")

'loop through range and pull out values
For i = 1 To rng.Columns.Count
    strValueFromRange = rng(i).Value 'gets the value certain spot in range
Next
0
 

Author Comment

by:centralmike
ID: 36537697
can you look at the entire code.  It code you sent me errors out at the following statement.
For i = 1 To rng.Columns.Count
.   Can you send me a copy the module with the changes you selected.  What if you have multiple ranges like B2 TO D2. Does the code handle this.  Thanks
0
 
LVL 16

Expert Comment

by:carsRST
ID: 36537748
>>  It code you sent me errors out at the following statement.

Assuming you know the name of the sheet, did you change it in this line of code?
Set rng = Activeworkbook.sheets("...YOUR sheet name...").Range("B10:D10")


>>What if you have multiple ranges like B2 TO D2
Same process as before.  Just change the Range selection, see line below
....Range("B10:D10")



>>  I ONLY WANT TO REFEERENCE THE FOLLOWING CELLS FROM EACH SHEET

See more sample code below.
'YOUR CODE
appExcel.Workbooks.Open strFolderPath & strPath
appExcel.Visible = True



Dim rng As Range
Dim sht As Worksheet

'loop through each sheet
For a = 1 To ActiveWorkbook.Sheets.Count

    With ActiveWorkbook.Sheets(a)
    
        'set range
        Set rng = Range("B10:D10")
        
        'get value from range
        For i = 1 To rng.Columns.Count
            strValueFromRange = rng(i).Value
            
            'execute SQL INSERT
        Next
        
        
        'set NEW range selection
        Set rng = Range("B2:D2")
        
        'get value from range
        For i = 1 To rng.Columns.Count
            strValueFromRange2 = rng(i).Value
            
            'execute SQL INSERT
        Next
        
    End With

Next a

Open in new window

0
Get MySQL database support online, now!

At Percona’s web store you can order your MySQL database support needs in minutes. No hassles, no fuss, just pick and click. Pay online with a credit card.

 
LVL 16

Expert Comment

by:carsRST
ID: 36537755
With that last code, you do not need to know the name of each sheet.  It will loop through EVERY sheet on the just opened workbook and get the values from the ranges you've specified.

0
 
LVL 16

Expert Comment

by:carsRST
ID: 36537873
Sorry...make sure to include a "dot" before the Ranges.


Corrected code below.
'YOUR CODE
appExcel.Workbooks.Open strFolderPath & strPath
appExcel.Visible = True



Dim rng As Range
Dim sht As Worksheet

'loop through each sheet
For a = 1 To ActiveWorkbook.Sheets.Count

    With ActiveWorkbook.Sheets(a)
    
        'set range
        Set rng = .Range("B10:D10")
        
        'get value from range
        For i = 1 To rng.Columns.Count
            strValueFromRange = rng(i).Value
            
            'execute SQL INSERT
        Next
        
        
        'set NEW range selection
        Set rng = .Range("B2:D2")
        
        'get value from range
        For i = 1 To rng.Columns.Count
            strValueFromRange2 = rng(i).Value
            
            'execute SQL INSERT
        Next
        
    End With

Next a

Open in new window

0
 

Author Comment

by:centralmike
ID: 36538688
I think your close. Still not working.  I will you send you a copy of the function.  The excel workbooks have multiple sheets in them.  All the workbooks have a sheet called "test" where I want to reference the data from.  Here is the entire function.  You can the way I am inserting the records into the table.

Public Function MYPREMLOAD2()


    Dim strPath As String, strFolderPath As String
    Dim appExcel As Excel.Application
    Dim MyDB As DAO.Database, MyRS As DAO.Recordset
   ' Dim rng As Range
    'Dim LastRow As Long
   
    DoCmd.SetWarnings False
    strsql = "Delete * From tblPolicyLoad;"
    DoCmd.RunSQL strsql
    DoCmd.SetWarnings True
 
    Set MyDB = CurrentDb()
   
    Set MyRS = MyDB.OpenRecordset("tblPolicyLoad", dbOpenDynaset)
     
 
    strFolderPath = "X:\Special Risk\miketesting\KARA\"
    strPath = "X:\Special Risk\miketesting\KARA\*.xls"
     
    strPath = Dir(strPath, vbNormal)
    Set appExcel = CreateObject("Excel.Application")
     

    Do While strPath <> ""
        appExcel.Workbooks.Open strFolderPath & strPath
        appExcel.Visible = True
       
      Dim rng As Range
      Dim sht As Worksheet

'loop through each sheet
For a = 1 To ActiveWorkbook.Sheets.Count

    With ActiveWorkbook.Sheets(a)
   
        'set range
        Set rng = .Range("C8:C10")
       
        'get value from range
        For i = 1 To rng.Columns.Count
            strValueFromRange = rng(i).Value
            With MyRS
            .AddNew
            !Benefit_Period = UCase(appExcel.Range("C8").Value)
            !EFFECTIVE_DATE = UCase(appExcel.Range("C9").Value)
            !FileName = UCase(appExcel.Range("C10").Value)
            .Update
            End With
            'execute SQL INSERT
        Next
 End With
 Next a

  strPath = Dir
    Loop
     
    appExcel.Quit
    Set appExcel = Nothing
    'appExcel.ActiveWorkbook.Close
    MyRS.Close
    Set MyRS = Nothing
     
    MsgBox "This Process has completed!"
End Function
0
 

Author Comment

by:centralmike
ID: 36543851
Do you have any additional suggestions.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 36547236
Thanks Mike for the email. I can see that carsRST is already helping you with the query :)

I would suggest that you be patient and wait for his reply :)

Sid
0
 
LVL 16

Expert Comment

by:carsRST
ID: 36553973
Mike, I'm not able to completely test, but give this a shot.  
Public Function MYPREMLOAD2()


    Dim strPath As String, strFolderPath As String
    Dim appExcel As Excel.Application
    Dim MyDB As DAO.Database, MyRS As DAO.Recordset
    
    DoCmd.SetWarnings False
    strsql = "Delete * From tblPolicyLoad;"
    DoCmd.RunSQL strsql
    DoCmd.SetWarnings True
 
    Set MyDB = CurrentDb()
    
    Set MyRS = MyDB.OpenRecordset("tblPolicyLoad", dbOpenDynaset)
     
  
    strFolderPath = "X:\Special Risk\miketesting\KARA\"
    strPath = "X:\Special Risk\miketesting\KARA\*.xls"
     
    strPath = Dir(strPath, vbNormal)
    Set appExcel = CreateObject("Excel.Application")
     

    Do While strPath <> ""
        appExcel.Workbooks.Open strFolderPath & strPath
        appExcel.Visible = True
    
        With ActiveWorkbook.Sheets("test")
                With MyRS
                    .AddNew
                    !Benefit_Period = UCase(.Range("C8").Value)
                    !EFFECTIVE_DATE = UCase(.Range("C9").Value)
                    !Filename = UCase(.Range("C10").Value)
                    .Update
                End With
                'execute SQL INSERT
        End With
        
        appExcel.ActiveWorkbook.Close
    
        strPath = Dir
    Loop
     
    appExcel.Quit
    Set appExcel = Nothing
    
    MyRS.Close
    Set MyRS = Nothing
     
    MsgBox "This Process has completed!"
End Function

Open in new window

0
 
LVL 16

Accepted Solution

by:
carsRST earned 2000 total points
ID: 36553978
Sorry I had to make one additional change since it looks as if you're running outside of Excel itself.
Public Function MYPREMLOAD2()


    Dim strPath As String, strFolderPath As String
    Dim appExcel As Excel.Application
    Dim MyDB As DAO.Database, MyRS As DAO.Recordset
    
    DoCmd.SetWarnings False
    strsql = "Delete * From tblPolicyLoad;"
    DoCmd.RunSQL strsql
    DoCmd.SetWarnings True
 
    Set MyDB = CurrentDb()
    
    Set MyRS = MyDB.OpenRecordset("tblPolicyLoad", dbOpenDynaset)
     
  
    strFolderPath = "X:\Special Risk\miketesting\KARA\"
    strPath = "X:\Special Risk\miketesting\KARA\*.xls"
     
    strPath = Dir(strPath, vbNormal)
    Set appExcel = CreateObject("Excel.Application")
     

    Do While strPath <> ""
        appExcel.Workbooks.Open strFolderPath & strPath
        appExcel.Visible = True
    
        With appExcel.ActiveWorkbook.Sheets("test")
                With MyRS
                    .AddNew
                    !Benefit_Period = UCase(.Range("C8").Value)
                    !EFFECTIVE_DATE = UCase(.Range("C9").Value)
                    !Filename = UCase(.Range("C10").Value)
                    .Update
                End With
                'execute SQL INSERT
        End With
        
        appExcel.ActiveWorkbook.Close
    
        strPath = Dir
    Loop
     
    appExcel.Quit
    Set appExcel = Nothing
    
    MyRS.Close
    Set MyRS = Nothing
     
    MsgBox "This Process has completed!"
End Function

Open in new window

0
 

Author Closing Comment

by:centralmike
ID: 36573754
This code worked perfectly.
0

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

752 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