Cells to read Excel > Access

Timoo

Registered User.
Local time
Today, 06:48
Joined
May 9, 2012
Messages
30
*EDIT: see 3rd post for solution/solvation

Hi,

Right now I am building a database with items, coming from local dealers.
We send them a locked excel sheet, which they feed with dealer information and item information. In the excel sheet, this is being separated (in the background) in 2 different sheets. I have my master sheet, which is being maintained by the dealer, and I have 2 slave sheets, which I import into Access.

In my first steps into VBA I learned to copy/paste code to import those files into 1 table. (See code below).
I am a virtual VBA n00b, so know nothing about it, yet.
I will have to, though, since I plan to set up this database in VBA.

Code:
[FONT=Arial]Sub Link_To_Excel()[/FONT]
[FONT=Arial]'Macro Loops through the specified directory (strPath)[/FONT]
[FONT=Arial]'and links ALL Excel files as linked tables in the Access Database.[/FONT]
 
[FONT=Arial]Const strPath As String = "\\serverpath\New Files for upload\" 'Directory Path[/FONT]
[FONT=Arial]Dim strFile As String 'Filename[/FONT]
[FONT=Arial]Dim strFileList() As String 'File Array[/FONT]
[FONT=Arial]Dim intFile As Integer 'File Number[/FONT]
 
[INDENT][FONT=Arial]'Loop through the folder & build file list[/FONT]
[FONT=Arial]strFile = Dir(strPath & "*.xlsx")[/FONT]
[FONT=Arial]While strFile <> ""[/FONT]
[FONT=Arial][/FONT] 
[FONT=Arial]'add files to the list[/FONT]
[FONT=Arial]intFile = intFile + 1[/FONT]
[FONT=Arial]ReDim Preserve strFileList(1 To intFile)[/FONT]
[FONT=Arial]strFileList(intFile) = strFile[/FONT]
[FONT=Arial]strFile = Dir()[/FONT]
[FONT=Arial]Wend[/FONT]
[FONT=Arial][/FONT] 
[FONT=Arial]'[/FONT][FONT=Arial]see if any files were found[/FONT]
[FONT=Arial]If intFile = 0 Then[/FONT]
[FONT=Arial]MsgBox "No files found"[/FONT]
[FONT=Arial]Exit Sub[/FONT]
[FONT=Arial]End If[/FONT]
[/INDENT][INDENT][FONT=Arial]'cycle through the list of files & import to Access[/FONT]
[FONT=Arial]'appending to tables called DealerLists and DealerContacts[/FONT]
[FONT=Arial]For intFile = 1 To UBound(strFileList)[/FONT]
[/INDENT][INDENT][INDENT][FONT=Arial]DoCmd.TransferSpreadsheet acImport, , _[/FONT]
[FONT=Arial]"DealerLists", strPath & strFileList(intFile), True, [B]"parts!A1:E229"[/B][/FONT]
[FONT=Arial]DoCmd.TransferSpreadsheet acImport, , _[/FONT]
[FONT=Arial]"DealerContacts", strPath & strFileList(intFile), True, [B]"contact!A1:F2"[/B][/FONT]
[/INDENT][FONT=Arial]Next[/FONT]
[/INDENT][FONT=Arial]MsgBox UBound(strFileList) & " Files were Imported"[/FONT]
[FONT=Arial][/FONT] 
[FONT=Arial]End Sub[/FONT]




Now I have 3 challenges:
  1. One is, to know up front which dealer (information) is being imported. In the DealerContacts table, I have a lot of dealers. And if I get a new sheet of an existing dealer, I want to know if it already exists in the list or not. I want to be able to refresh the information, if the dealer already exists.
    • How do I read out a specific cell, to be able to decide whether I should update or append the information?
    • And how do I update the record, if it already exists?
  2. The second is, to remove old information in the item table and append new information.
    • Once I have the dealer number, recorded in the previous session, how can I use this to delete all related records in an item list?
    • Kind of: build a query, related to this dealer number, and delete all records with this specific number?
  3. Last but not least: to make sure I do not import empty cells (dealers have 228 records to their availability, but will seldom use that), I have a counter in sheet 4. This sheet contains only title and a number; number of lines filled with data.
    • Essentially this is the same problem as 1., because I need to feed the information of this specific cell to a variable, which I then use to set the TransferSpreadsheet Command with the right amount of lines: import "parts!A1:E" & NumberOfLines
    • This is the code I was trying, but it doesn't seem to work (fails at first line):
Code:
[FONT=Arial]'Read the number of lines in the file [/FONT]
[FONT=Arial]Dim xl As Excel.Application[/FONT]
 
[FONT=Arial]Dim xlsht As Excel.worksheet[/FONT]
[FONT=Arial]Dim xlWrkBk As Excel.Workbook[/FONT]
[FONT=Arial]Dim xlCell As Double[/FONT]
 
[FONT=Arial]Set xl = CreateObject("Excel.Application")[/FONT]
[FONT=Arial]Set xlWrkBk = GetObject(strPath & strFileList(intFile))[/FONT]
[FONT=Arial]Set xlsht = xlWrkBk.Worksheets("Counters")[/FONT]
[FONT=Arial]Set xlCell = xlsht.cells(2, "A")[/FONT]
 
[FONT=Arial]DoCmd.TransferSpreadsheet acImport, , _[/FONT]
[FONT=Arial]"DealerLists", strPath & strFileList(intFile), True, [B]"parts!A1:E"[/B] [B]& NumberOfLines[/B][/FONT]
 
[FONT=Arial]Set xl = Nothing[/FONT]
[FONT=Arial]Set xlWrkBk = Nothing[/FONT]
[FONT=Arial]Set xlsht = Nothing[/FONT]
[FONT=Arial]Set xlCell = Nothing [/FONT]

Who can help me out in this?

Thanks in advance,
Timoo
 
Last edited:
OK, so far so good.
First solution to store a value in a variable was given here:
http://www.access-programmers.co.uk/forums/showthread.php?t=236762

Although not 100% correct, it helped me getting started.
So, solution no. 1:

Code:
        'Get the counter value
        Set objApp = CreateObject("Excel.Application")
        objApp.Visible = False
        Set wb = objApp.Workbooks.Open(strPath & strFileList(intFile), True, False)
        counter = wb.Sheets("counters").[B]Cells(2, "A")[/B].Value
        wb.Close ' or whatever you use to close excel.. my brain hurts today so look it up
        Set objApp = Nothing

        'Import the files
        DoCmd.TransferSpreadsheet acImport, , _
        "Lists", strPath & strFileList(intFile), True, "list!A1:E" & counter
        DoCmd.TransferSpreadsheet acImport, , _
        "Contacts", strPath & strFileList(intFile), True, "contact!A1:F2"
 
Fixed and working.
For all of you having the same concept/problems:

A bunch of randomly named Excel files with a strict format (template) are imported into several Access tables. I have 2 sheets (sheet 2 & 3) that I need information from to be imported, I have 1 sheet (4) with 2 variables that I need read in order to compare with my tables.

Eventually those 2 sheets are appended to my contact information table and material list.

Code:
Sub Link_To_Excel()
[COLOR="Green"]     'Macro Loops through the specified directory (strPath)
     'and links ALL Excel files as linked tables in the Access Database.
[/COLOR]     
    Const strPath As String = "\\wat-be8k230\DICE EMEA Aftermarket\03. Parts Customer Service\Trader Joe\Trader Joe New Files for upload\" 'Directory Path
    Dim strFile As String
    Dim strFileList() As String
    Dim intFile As Integer
     
     [COLOR="Green"]'Loop through the folder & build file list[/COLOR]
    strFile = Dir(strPath & "*.xlsx")
    While strFile <> ""
         'add files to the list
        intFile = intFile + 1
        ReDim Preserve strFileList(1 To intFile)
        strFileList(intFile) = strFile
        strFile = Dir()
    Wend
[COLOR="Green"]     'see if any files were found[/COLOR]
    If intFile = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
     
[COLOR="green"]     'cycle through the list of files & import to Access
     'appending to tables called DealerLists and DealerContacts
[/COLOR]    For intFile = 1 To UBound(strFileList)
        
[COLOR="green"]         'Get the counter & customer value
[/COLOR]        Set objApp = CreateObject("Excel.Application")
        objApp.Visible = False
        Set wb = objApp.Workbooks.Open(strPath & strFileList(intFile), True, False)
            counter = wb.Sheets("counters").Cells(2, "A").Value
            customer = wb.Sheets("counters").Cells(2, "B").Value
        wb.Close
        Set objApp = Nothing

[COLOR="green"]         'Look for & delete existing Contact information
[/COLOR]        Dim dbTraderJoe As DAO.Database
        Dim rstContacts As DAO.Recordset
        
        Set dbTraderJoe = CurrentDb
        Set rstContacts = dbTraderJoe.OpenRecordset("DealerContacts")
      
        Do While Not rstContacts.EOF
            If rstContacts!DealerNumber = customer Then
                rstContacts.Delete
            End If
            rstContacts.MoveNext
        Loop
        
[COLOR="green"]         'Look for & delete existing records
[/COLOR]        Dim rstDealers As DAO.Recordset
        Set rstDealers = dbTraderJoe.OpenRecordset("DealerLists")
        
        Do While Not rstDealers.EOF
            If rstDealers!DealerNumber = customer Then
                rstDealers.Delete
            End If
            rstDealers.MoveNext
        Loop
        
        rstContacts.Close
        rstDealers.Close
        dbTraderJoe.Close
        
[COLOR="green"]         'Import the material list
[/COLOR]        DoCmd.TransferSpreadsheet acImport, , _
        "DealerLists", strPath & strFileList(intFile), True, "parts!A1:E" & counter
        
[COLOR="green"]         'Import the contact sheet
[/COLOR]        DoCmd.TransferSpreadsheet acImport, , _
        "DealerContacts", strPath & strFileList(intFile), True, "contact!A1:F2"
         
    Next
    MsgBox UBound(strFileList) & " Files were Imported"

End Sub
Works like a charm...
Thanks to all bits & pieces on this forum!

Thank you all for posting!!!!
 

Users who are viewing this thread

Back
Top Bottom