Question : Access Import of Excel Customized Date Formats into Text Field

Hello EE,

I am using Access 2007 to import an Excel file with dates into a table that is all text fields. (The columns within the Excel files move around and there's a separate process that maps these using a schema.)

My problem is that a user may enter a date into an Excel date field as 11/01/09, but sometimes the users have date "formatted" to look like Nov-09 (mmm-yy). After the import the Access table has the value of "Nov-09". When converting this back to a date it becomes 11/09/2010.

How do I import the underlying date value from Excel (40118) into the Access table's text field, if it exists, so that the proper date can be extracted from that field when that data is reformatted? Hopefully it is just a transferspreadsheet switch.

I am using the following to import:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImportXLS", .Fields("FullFilePath"), False, .Fields("FileTabName")
Thanks,

LVBarnes

Answer : Access Import of Excel Customized Date Formats into Text Field

Hi lvbarnes,

I've created an example for you.

This procedure will take in any xl data file and import to a given table in access.

Required references: (Go to Tools => References...)
Microsoft Office Object Library
Microsoft DAO 3.6 Object Library
Microsoft Excel 11.0 Object Library

CONSTRAINTS!
Data must start in cell A1 (first row can be a header row.)
First row must NOT contain blank cells in column range.
First column must NOT contain blank cells in data range.

(Will only import fields up to the first blank cell in first column and data up to the first blank cell in the first row.)

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:

           
           
             'Imports xlData from given xl file to given access table
'Will replace any access table with given name
Public Sub ImportExcelData()
  Dim t As String 'table name
  Dim wb As Excel.Workbook
  Dim ws As Excel.Worksheet
  Dim r As Range
  Dim fd As FileDialog
  Dim fn As String 'filename
  Dim q As Integer
  Dim fns As String 'field names
  Dim fdcnt As Integer 'field count
  Dim dat As String 'data values
  Dim sql As String
  Dim i As Integer
  Dim vnt As Variant
    
  DoCmd.SetWarnings False
  On Error GoTo Err_ImportExcelData
  
  'Get data filename
  Set fd = FileDialog(msoFileDialogFilePicker)
  With fd
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls"
    If .Show Then
      fn = .SelectedItems(1) 'File to import.
    Else
      Exit Sub
    End If
  End With
  Set wb = GetObject(fn)
  Set ws = wb.Sheets(1)
  
  'Check if file contains header row
  q = MsgBox("First row contains field names?", vbYesNo + vbQuestion)
  
  'Get number of fields and field names if header row exists
  fdcnt = 0
  For Each r In ws.Range(ws.Range("A1"), ws.Range("A1").End(xlToRight))
    If q = vbYes Then
      fns = fns & "," & r
    End If
    fdcnt = fdcnt + 1
  Next r
  fns = Mid(fns, 2) 'remove preceding comma
  
  'Create data table
  t = InputBox("Enter table name to import to." & Chr(13) & _
                "Note, if table already exists it will be replaced." & Chr(13) & _
                "(I.e. any existing information will be deleted.)")
  On Error Resume Next
  DoCmd.RunSQL "DROP TABLE " & t & ""
  On Error GoTo Err_ImportExcelData
  sql = "CREATE TABLE " & t & " ("
  If q = vbYes Then
    vnt = Split(fns, ",")
    For i = 0 To UBound(vnt)
      vnt(i) = vnt(i) & " text"
    Next i
    sql = sql & Join(vnt, ",") & ")"
  Else
    For i = 1 To fdcnt
      fns = fns & "," & "[Field" & i & "] text"
    Next i
    sql = sql & Mid(fns, 2) & ")"
  End If
  DoCmd.RunSQL sql
  
  'Add data values
  For Each r In ws.Range(ws.Range(IIf(q = vbYes, "A2", "A1")), ws.Range(IIf(q = vbYes, "A2", "A1")).End(xlDown))
    dat = ""
    For i = 0 To fdcnt - 1
      dat = dat & ",'" & r.Offset(0, i).Value & "'"
    Next i
    dat = Mid(dat, 2) 'remove preceding comma
    sql = "INSERT INTO " & t & " " & IIf(q = vbYes, "(" & fns & ")", "") & " VALUES (" & dat & ")"
    DoCmd.RunSQL sql
  Next r
  
Done:
  If Not wb Is Nothing Then
    wb.Application.DisplayAlerts = False
    wb.Application.Quit
  End If
  Set wb = Nothing
  Set ws = Nothing
Exit Sub
Err_ImportExcelData:
  MsgBox Err.Description
  Resume Done
End Sub

           
         

Open in New Window

Select All