Extract date from filename

[china99boy]

I think I am on the right track, but I am stuck with importing the date from my excel filename. Currently the following code imports all Excel files from the directory into a table in my database. The excel files are saved like "ABC_BNG_GTR_04012008.XLS" The numbers represent the date. I need for the date to be extracted and place in table into the "callDate" field. When I run my code, I continue to get a runtime error 13 - type mismatch. The code stops at the Mid() statement. What am I doing incorrectly? Thanks in advance.

Option Compare Database

Private Sub btnImport_Click()
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
Dim TheDate As Date

 
  DoCmd.SetWarnings False
  path = "C:\Users\Chinaboy\Desktop\Data\"
 
  'Loop through the folder & build file list
  strFile = Dir(path & "\*.xls")
 
  While strFile <> ""
     'add files to the list
     intFile = intFile + 1
     ReDim Preserve strFileList(1 To intFile)
     strFileList(intFile) = strFile
      strFile = Dir()
  Wend
 
  'see if any files were found
  If intFile = 0 Then
    MsgBox "No files found"
    Exit Sub
  End If
 
  'cycle through the list of files
  For intFile = 1 To UBound(strFileList)
    filename = path & strFileList(intFile)
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "sheet2", filename, False
    
    'Inserts date in date column based on file name
    
    TheDate = Mid(strFile, 12, 8)

    CurrentDb.Execute "UPDATE sheet2 SET callDate =" & "'" & TheDate & "' where callDate is null"
  
  
  Next intFile
 
  DoCmd.SetWarnings True

End Sub

 

[ajetrumpet]

it looks like you have tried to assign a string to a variable that has been declared as a date (TheDate). In other words, you are trying to assign a value that is 04012008 to the variable called TheDate. Something like this might possibly work for you:

TheDate = mid(strfile, 12, 2) & "/" & _
   mid(strfile, 14, 2) & "/" & _
      mid(strfile, 16, 4)

I have done that with a few of my samples and it has worked for me.

 

[china99boy]

Thank you for such a fast response. I tried your code, but still came up with the same error. Am I possible doing something else wrong. The field that the date should import too, is set to date/time on the table.

Option Compare Database

Private Sub btnImport_Click()
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
Dim TheDate As Date

 
  DoCmd.SetWarnings False
  path = "C:\Users\Chinaboy\Desktop\Data\"
 
  'Loop through the folder & build file list
  strFile = Dir(path & "\*.xls")
 
  While strFile <> ""
     'add files to the list
     intFile = intFile + 1
     ReDim Preserve strFileList(1 To intFile)
     strFileList(intFile) = strFile
      strFile = Dir()
  Wend
 
  'see if any files were found
  If intFile = 0 Then
    MsgBox "No files found"
    Exit Sub
  End If
 
  'cycle through the list of files
  For intFile = 1 To UBound(strFileList)
    filename = path & strFileList(intFile)
    
    
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "sheet2", filename, False
    
    'Inserts date in date column based on file name
    
    TheDate = Mid(strFile, 12, 2) & "/" & _
        Mid(strFile, 14, 2) & "/" & _
            Mid(strFile, 16, 4)
            
            
    CurrentDb.Execute "UPDATE sheet2 SET callDate =" & "'" & TheDate & "' where callDate is null"
    
    
  Next intFile
 
  DoCmd.SetWarnings True

End Sub

Private Sub Command0_Click()
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls", 1
.Filters.Add "All Files", "*.*", 2
If .Show = -1 Then
strFilename = .SelectedItems(1)

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "sheet2", strFilename, False

Else
Exit Sub

End If

End With

Exit_Command0_Click:
Exit Sub

Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click

End Sub

 

[ajetrumpet]

    TheDate = Mid(strFile, 12, 8)

    CurrentDb.Execute "UPDATE sheet2 SET callDate =" & "'" & TheDate & "' where callDate is null

You might try using the Date Conversion function on the newly created date values:

TheDate = cdate(mid(strfile, 12, 2) & "/" & _
   mid(strfile, 14, 2) & "/" & _
      mid(strfile, 16, 4))

However, I don't think this is the problem. This section of your SQL code is trying to write a string value into the "CallDate" field:

callDate =" & "'" & TheDate & "'

Try using this instead:

callDate = " & TheDate

Or, you might have to enclose TheDate in # signs instead of quote marks, but I don't think you need them when Updating or Appending.

 

[china99boy]

I am getting stuck at this part of the code. Same error, but thanks for your patients.

TheDate = cdate(mid(strfile, 12, 2) & "/" & _
   mid(strfile, 14, 2) & "/" & _
      mid(strfile, 16, 4))

 

[boblarson]

Maybe this:

TheDate = DateSerial(mid(strfile, 12, 2),mid(strfile, 14, 2),mid(strfile, 16, 4))

 

[ajetrumpet]

or maybe this is the problem:

  DoCmd.SetWarnings False
  path = "C:\Users\Chinaboy\Desktop\Data\"
 
  'Loop through the folder & build file list
  [COLOR="Red"][B]strFile = Dir(path & "\*.xls")[/B][/COLOR]

In the above code, the variable strFile has 2 backslashes in it. One from the path variable declaration, and the other from the Dir() function concatenation. That would obviously be a mismatch. Shouldn't the Dir() function be this:

strFile = Dir(path & "*.xls")

?????

 

[boblarson]

Good point Adam - Funny how we were all focused on the date variable and, it would be good to know where exactly the line errored out instead of assuming, eh?

 

[ajetrumpet]

Yeah, no kidding. But he said the block was in error at the Mid() function, which can be caused by the two backslashes...

 

[china99boy]

I really don't know what I may be doing wrong, I tried both your suggestions and still getting the error at the

TheDate = DateSerial(Mid(strFile, 12, 2), Mid(strFile, 14, 2), Mid(strFile, 16, 4))

Option Compare Database

Private Sub btnImport_Click()
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
Dim TheDate As Date


DoCmd.SetWarnings False
path = "C:\Users\Chinaboy\Desktop\Data\"

'Loop through the folder & build file list
strFile = Dir(path & "*.xls")

While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend

'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If

'cycle through the list of files
For intFile = 1 To UBound(strFileList)
strFile = path & strFileList(intFile)


DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "sheet2", strFile, False

'Inserts date in date column based on file name

TheDate = DateSerial(Mid(strFile, 12, 2), Mid(strFile, 14, 2), Mid(strFile, 16, 4))

CurrentDb.Execute "UPDATE sheet2 SET callDate =" & "'" & TheDate & "' where callDate is null"


Next intFile

DoCmd.SetWarnings True

End Sub

 

[ajetrumpet]

Insert the line in red and see what comes up in the immediate window:

[color=red]debug.print strFile[/color]

    TheDate = DateSerial(Mid(strFile, 12, 2), Mid(strFile, 14, 2), Mid(strFile, 16, 4))
            
       CurrentDb.Execute "UPDATE sheet2 SET callDate =" & "'" & TheDate & "' where callDate is null"

Also, put a breakpoint at the DateSerial() line so you don't get the error.

 

[china99boy]

This is what shows up in the immediate window

C:\Users\Chinaboy\Desktop\Data\icd_csq_agent_summary_20080402.xls

 

[ajetrumpet]

If that is what shows up China boy, then you are trying to write alpha characters to your date field. The date numbers that you want start at CHAR # 55, not 12. So:

TheDate = Mid(strFile, 55, 2) & "/" & _
    Mid(strFile, 57, 2) & "/" & Mid(strFile, 59, 4)

 

[china99boy]

That was the problem, I thought I just needed to count from just the file name, did not realize that I needed to count the entire file path. Than you for your patients.

 

[ajetrumpet]

not a problem. I'm glad you finally got it going!

 

[china99boy]

Hi, I had to make some changes to my database because of the formating of the file name in excel. I need to extract the date from the filename. The date will always be before the extension (.xls). Example ABCDEFG_DAILY_04_01_2008.xls. The length of the first part of the file name is constantly changing so I would need to count from the extension.

I tried the following code to do that, but I a missing something. I continue to get Type mismatch. Is there a better method to do this.

'Adds date to callDate field based on the date on file name.


    Dim fDateFromFile As Date    
    Dim lngYear         As Long
    Dim lngMonth        As Long
    Dim lngDay          As Long
    Dim lngStopPos      As Long

    lngStopPos = InStr(Len(strFile) - 5, strFile, ".")

    lngDay = CLng(Mid(strFile, lngStopPos - 11, 2))
    lngMonth = CLng(Mid(strFile, lngStopPos - 7, 2))
    lngYear = CLng(Mid(strFile, lngStopPos - 4, 4))

    'fDateFromFile = DateSerial(lngMonth, lngDay, lngYear)
    
    'Date format MM/DD/YYYY

                
'  TheDate = Mid(strFile, 54, 2) & "/" & _
'   Mid(strFile, 56, 2) & "/" & _
'      Mid(strFile, 58, 4)
       CurrentDb.Execute "UPDATE tblAgentSummary SET callDate =" & "'" & fDateFromFile & "' where callDate is null"

 

[boblarson]

Well, one thing - DateSerial is used wrong. you have to put in the YEAR first, the MONTH next and the Day last.

 

[gemma-the-husky]

out of interest , there may be a recurrent problem if you are are expecting certain path lengths - what if you use another folder

why not find the first numeric (not tested, but looks OK)

dim datebit as string
dim pos as long
dim maxlen as long
dim ch as string

'now check a char at a time until you find the first numeric - is there an easier way?

datebit = ""
maxlen = len(fullfilename)
pos=1
while pos<=maxlen
  ch=mid(fullfilename,pos,1)
  if ch>="0" and ch<="9" then
    datebit = str(val(mid(fullfilename,pos)))
    goto gotit
  end if
  pos=pos+1
wend

'datebit now holds the date string bit of the file name

 

[china99boy]

Thanks for all your help. I just tried your code but got a compile error at the " GoTo gotit" Line

 

[boblarson]

Instead of GoTo GotIt, use

Exit While (I THINK that is the syntax. I use Do/Loop instead of While/Wend and you use an Exit Do when you want out of the loop, so hopefully it is Exit While.)