Question

我有一些VBA代码，用于将Excel电子表格的特定列导入我的Access数据库。

每个工作日都会生成导入数据库的文件，我计划在每周开始时运行导入过程。

我面临的问题是我当前的代码导入了目录中的每个电子表格，而不仅仅是前一周生成的新电子表格。导入的文件按以下格式命名：＆＃34; FD工作表01 07 2016＆＃34;，日期部分是生成日期。在数据库中有一个名为＆＃34; file_date＆＃34;的字段。从下面的代码中可以看出，这是将文件导入数据库时存储文件的日期，以便能够识别数据来自哪个文件。

有人可以帮我修改我的代码，只导入数据库中缺少的电子表格吗？即首先搜索数据库以检查文件是否先前已导入，如果是，请忽略它？

非常感谢。

Option Compare Database

Public Function importExcelSheets()

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim astrPieces() As String
Dim dteFileDate As Date
Dim strDir As String
Dim strFile As String
Dim strInsert As String
Dim Directory As String
Dim TableName As String

Directory = "F:\FD Worksheets\jul 2016"
TableName = "FD Worksheets"

Dim strTable As String
Dim I As Long
I = 0

 If Right(Directory, 1) <> "\" Then
     strDir = Directory & "\"
 Else
     strDir = Directory
 End If
 strFile = '" strFile = Dir(strDir & "*.XLSX")      

 While strFile <> ""
     I = I + 1
     Debug.Print "importing " & strFile

If Not strDir Like "*\" Then
    strDir = strDir & "\"
End If
strInsert = "INSERT INTO [FD Worksheets] (file_date, Prod, Average_Cost, WSP)" & vbCrLf & _
    "SELECT [which_date] as file_date, xl.Prod, xl.Average_Cost, xl.WSP" & vbCrLf & _
    "FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;DATABASE=" & strDir & strFile & "].[Sheet1$] AS xl;"
Debug.Print strInsert
astrPieces = Split(Left(strFile, Len(strFile) - 5), " ")
dteFileDate = DateSerial(Val(astrPieces(4)), astrPieces(3), astrPieces(2))
Debug.Print dteFileDate
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strInsert)
qdf.Parameters("which_date").Value = dteFileDate
qdf.Execute dbFailOnError

     strFile = Dir()
Wend

End Function

Answer 1

你需要使用带有周数的if子句，试试下面的代码，它是未经测试的

Option Compare Database

Public Function importExcelSheets()

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim astrPieces() As String
Dim dteFileDate As Date
Dim strDir As String
Dim strFile As String
Dim strInsert As String
Dim Directory As String
Dim TableName As String

Directory = "F:\FD Worksheets\jul 2016"
TableName = "FD Worksheets"

Dim strTable As String
Dim I As Long
I = 0

 If Right(Directory, 1) <> "\" Then
     strDir = Directory & "\"
 Else
     strDir = Directory
 End If
 strFile = '" strFile = Dir(strDir & "*.XLSX")      

 While strFile <> ""


     'Add This Line
     if Format(Mid(strfile, 14, 10), "ww") = format(date(), "ww") -1 then


     I = I + 1
     Debug.Print "importing " & strFile

If Not strDir Like "*\" Then
    strDir = strDir & "\"
End If
strInsert = "INSERT INTO [FD Worksheets] (file_date, Prod, Average_Cost, WSP)" & vbCrLf & _
    "SELECT [which_date] as file_date, xl.Prod, xl.Average_Cost, xl.WSP" & vbCrLf & _
    "FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;DATABASE=" & strDir & strFile & "].[Sheet1$] AS xl;"
Debug.Print strInsert
astrPieces = Split(Left(strFile, Len(strFile) - 5), " ")
dteFileDate = DateSerial(Val(astrPieces(4)), astrPieces(3), astrPieces(2))
Debug.Print dteFileDate
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strInsert)
qdf.Parameters("which_date").Value = dteFileDate
qdf.Execute dbFailOnError
'and this one
end if
     strFile = Dir()
Wend

End Function

如何仅使用现有VBA代码将新文件导入Access DB

1 个答案: