Solved

MICROSOFT ACCESS 2007/Excel 2007

Posted on 2011-09-14
11
267 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
Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

 
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 500 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

Simplifying Server Workload Migrations

This use case outlines the migration challenges that organizations face and how the Acronis AnyData Engine supports physical-to-physical (P2P), physical-to-virtual (P2V), virtual to physical (V2P), and cross-virtual (V2V) migration scenarios to address these challenges.

Question has a verified solution.

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

Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
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…

726 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