Import rows and columns from excel (1 Viewer)

Dreamweaver

Well-known member
Local time
Today, 10:10
Joined
Nov 28, 2005
Messages
2,466
I have 330 excel sheets I need to import rows 77-101 and columm A,B,F,G,H

I have it working upto a point IE. It wont move to next excel row.

I have to do it with the code below as I will be adding a date to each entry in db which is part of the filename which is not a problem.
Code:
Sub AllExcelFilesInFolder()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String, StrExtShort As String
Dim myExtension As String
Dim R As DAO.Recordset
Dim i As Integer
Dim Ddate As Date
Dim Column
        StrExtShort = GetFolderName()
        If IsNothing(StrExtShort) Then Exit Sub
Debug.Print StrExtShort

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"
Set R = CurrentDb.OpenRecordset("SELECT * FROM Chart", dbOpenDynaset, dbAppendOnly)

'Target Path with Ending Extention
  myFile = Dir(StrExtShort & "\" & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(FileName:=StrExtShort & "\" & myFile)
    Debug.Print myFile
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
        For Each Column In Range("A77:H101").Columns ' repeat until first empty cell in column A
        i = 77
        With R
            .AddNew ' create a new record
            R("TW") = Range("A" & i).Value
            R("LW") = Range("B" & i).Value
            R("TITLE") = Range("F" & i).Value
            R("ARTIST") = Range("G" & i).Value
            R("LABEL") = Range("H" & i).Value
            R("ChartDate") = Ddate
            .Update
        End With
        i = i + 1
        Next
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents
     wb.Close SaveChanges:=False
    'Get next file name
      myFile = Dir
  Loop

 
End Sub

The results of above are show in attached image

Thanks
 

Attachments

  • 2021-03-18.png
    2021-03-18.png
    79.8 KB · Views: 531

Dreamweaver

Well-known member
Local time
Today, 10:10
Joined
Nov 28, 2005
Messages
2,466
Just noticed I had this in wrong place i = 77 but still only getting 6 rows
 

Dreamweaver

Well-known member
Local time
Today, 10:10
Joined
Nov 28, 2005
Messages
2,466
I've found a workaround It seems its only looping through the rows fro the number of columns so changed the code as I only want th last 25 rows

Code:
Sub AllExcelFilesInFolder()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String, StrExtShort As String
Dim myExtension As String
Dim R As DAO.Recordset
Dim i As Integer
Dim Ddate As Date
Dim rng As Range
        StrExtShort = GetFolderName()
        If IsNothing(StrExtShort) Then Exit Sub
'Debug.Print StrExtShort

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"
Set R = CurrentDb.OpenRecordset("SELECT * FROM Chart", dbOpenDynaset, dbAppendOnly)

'Target Path with Ending Extention
  myFile = Dir(StrExtShort & "\" & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(FileName:=StrExtShort & "\" & myFile)
    'Debug.Print myFile
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
        i = 77
        For Each rng In Range("A77:Y101").Columns ' repeat until first empty cell in column A
    Debug.Print i
        With R
            .AddNew ' create a new record
            R("TW") = Range("A" & i).Value
            R("LW") = Range("B" & i).Value
            R("TITLE") = Range("F" & i).Value
            R("ARTIST") = Range("G" & i).Value
            R("LABEL") = Range("H" & i).Value
            'R("ChartDate") = Ddate
            .Update
        End With
        i = i + 1
        Next rng
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents
     wb.Close SaveChanges:=False
    'Get next file name
      myFile = Dir
  Loop

 
End Sub

This gets me the data I need now I can clean it up and add the other data I need.

mick
 

bastanu

AWF VIP
Local time
Today, 03:10
Joined
Apr 13, 2010
Messages
1,401
Wouldn't be easier to use the Range argument of the Docmd.TransferSpreadsheet method?
DoCmd.TransferSpreadsheet acImport,acSpreadsheetTypeExcel12Xml , "tblYourTable","C:\....\test.xlsx", True, "A77:H101"

Cheers,
 

Dreamweaver

Well-known member
Local time
Today, 10:10
Joined
Nov 28, 2005
Messages
2,466
Didn't know I could do that very interestings but, no As I said I needed to add data which had to be done during the import as in this case I had just under 10,000 entries from 330 spredsheets I got it working as it was a one off I'm not worring about the code as it worked lol.

Many thanks

mick
 

bastanu

AWF VIP
Local time
Today, 03:10
Joined
Apr 13, 2010
Messages
1,401
Just wanted to give an alternative, the extra data could have been added as an Update statement after each import ("Where [ExtraData] Is Null).

Cheers,
 

Dreamweaver

Well-known member
Local time
Today, 10:10
Joined
Nov 28, 2005
Messages
2,466
Sorry no Each spreedsheet had different data once it was added in would have been messy sorting it out

thanks mick
 

Users who are viewing this thread

Top Bottom