Solved

MICROSOFT ACCESS 2007/Excel 2007

Posted on 2011-09-14
11
263 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
  • 6
  • 4
11 Comments
 
LVL 16

Expert Comment

by:carsRST
Comment Utility
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
Comment Utility
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
Comment Utility
>>  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
 
LVL 16

Expert Comment

by:carsRST
Comment Utility
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
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:centralmike
Comment Utility
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
Comment Utility
Do you have any additional suggestions.
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
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
Comment Utility
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 500 total points
Comment Utility
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
Comment Utility
This code worked perfectly.
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
We were having a lot of "Heartbeat Alerts" in our SCOM environment, now "Heartbeat" in a SCOM environment for those of you who might not be familiar with SCOM is a packet of data sent from the agent to the management server on a regular basis, basic…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

743 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now