Question

我通过从这个（和其他一些）网站中提取代码来创建这个过程，当我测试它时它就像一个魅力，但是当我部署它时，它很难崩溃... 我是新手时它来到VBA 并且无法找到合适的解决方案，所以我想请求帮助。

使用案例
会计师每天收到来自现场员工的100多个电子表格（！）作为所需报告的形式。在我介入之前，3位会计师将打开通过电子邮件收到的每个电子表格，并将某些单元格内容复制/粘贴到“主”电子表格中，该电子表格将在月底用于对帐。毋庸置疑，这已成为低效率。
我做了什么
我创建了一个Access DB并使用TransferSpreadsheet方法导入数据。我们需要从每个电子表格中导入只有11个单元格，因此我修改了员工用来将所有这些数据拉入隐藏选项卡的电子表格，其中所有数据都在一行中，所有行都在Access中的一个表中。正如我所提到的，当我和会计师测试解决方案时，它工作得很漂亮。
什么打破
第一个问题是，某个领域的人员没有相同版本的MS Office，有些人使用的是OpenOffice，我们在尝试导入某些电子表格时会遇到错误。但是，由于我的简单解决方案仅针对“完美路径”而构建，因此无法识别哪些电子表格失败，尤其是当其中有2000多个电子表格位于文件夹中时。
我希望能做什么 短期，直到我有时间掌握VBA，我很乐意添加一些错误处理程序。或者即使在导入之后，“好”电子表格也会被发送到一个文件夹，而“坏”电子表格将被发送到另一个文件夹。根据我的经验，大约80％的报告导入正常。一旦它遍历整个文件夹，会计师就可以检查“失败的导入”文件夹并手动输入。 Access VBA专家给您的问题是，这是可行的，是一个合理的解决方案吗？如果是的话，你能指导我吗？下面是我从互联网改编的当前代码。谢谢你的帮助！

Function DoImport()

Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer
Dim strWorksheets(1 To 1) As String


' the number of worksheets to be imported
' from each EXCEL file (this code assumes that each worksheet
' with the same name is being imported into a separate table
' for that specific worksheet name)
Dim strTables(1 To 1) As String

' worksheet names ;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strWorksheets(1) = "Data"

strTables(1) = "my_table"

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

'update the path to where the Excel files to be imported are
strPath = "\mypathhere\"

' the number of worksheets to be imported
' from each EXCEL file
For intWorksheets = 1 To 1

      strFile = Dir(strPath & "*.xlsm")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            'MsgBox strPathFile
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTables(intWorksheets), strPathFile, blnHasFieldNames, strWorksheets(intWorksheets) & "$"

            strFile = Dir()
      Loop

Next intWorksheets


End Function

Answer 1

这是我的头脑（所以可能有sytax错误），但想法是设置错误处理跳转到保存文件名然后跳回到进程的代码：

  ON ERROR GOTO IMPORT_ERROR 

For intWorksheets = 1 To 1

      strFile = Dir(strPath & "*.xlsm")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            'MsgBox strPathFile
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTables(intWorksheets), strPathFile, blnHasFieldNames, strWorksheets(intWorksheets) & "$"

            strFile = Dir()
GetNextFile:

      Loop

Next intWorksheets

EXIT FUNCTION

IMPORT_ERROR:
'ADD CODE HERE TO HANDLE ERROR

ON ERROR GOTO IMPORT_ERROR 

GOTO GetNextFile

End Function

使用VBA将数千个电子表格导入Access数据库表

1 个答案: