VBA 访问：带有空值的文件

Question

总体目标： 从文件夹中拉出所有文件 > 在临时表中格式化文件 > 将临时表复制到主表 > 终止临时表 > 冲洗并重复，直到所有文件都从文件夹中取出，格式化并放入主表。

问题： 我显然没有考虑到发送给我的某些文件会有空白工作表（相反，它们可能在单元格 A1 中显示“无数据”的值）。当我的宏点击“无数据”或空白表时，我收到 Null 错误 (94)。

我的尝试：

• strF1Data = Nz(!ref_val)
• strF1Data = Nz(!ref_val,"")

怀疑： 我想我可以更新 SQL UPDATE 行以允许 Null，但我觉得更有效的解决方案是跳过 null。但是我已经尝试修改 Do Until 语句并且没有运气......

可能值得一提： 这些文件有多个工作表。在其他几个确实有数据的工作表之间的随机工作表上发现这个错误时，我很难学到这一点。

代码：（为了节省一些空间，我只提供调用文件位和格式化部分，我认为其他部分没有任何用处。但是，如果你愿意喜欢他们然后告诉我。）

整体宏（请参阅下一个代码部分以了解错误部分）：

Sub Pull_File_into_Staging_Table()
'Process:
    '1 - Loop through all files saved to specified folder making an internal list of the files
    '2 - Paste one files content to staging table at a time
    '3 - Format the information in the staging table
    '4 - Copy formatted staging table to 1Compare Table (master table)

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
DoCmd.SetWarnings False
path = "C:\Users\USER\Desktop\Test\"
Dim rs As DAO.Recordset ' Moved from below
Dim db As DAO.Database
Set db = CurrentDb

'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, "Stage", filename, False

Call Format_Staging_Table
Call Copy_from_Stage_to_Master
Call Clear_Staging_Table

Next intFile
DoCmd.SetWarnings True
End Sub

有问题的部分：

Sub Format_Staging_Table()

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
DoCmd.SetWarnings False
path = "C:\Users\USER\Desktop\Test\"
Dim rs As DAO.Recordset ' Moved from below
Dim db As DAO.Database
Set db = CurrentDb

CurrentDb.Execute ("ALTER TABLE Stage ADD COLUMN UPC Text, SR_Profit_Center Text, SR_Super_Label Text, SAP_Profit_Center Text, SAP_Super_Label Text;")

CurrentDb.TableDefs("Stage").Fields("F1").Name = "ref_val"


Dim ref_val As String
Set rs = db.OpenRecordset("SELECT TOP 1 ref_val FROM Stage;", dbOpenDynaset)
ref_val = rs.Fields(0).Value
rs.Close

db.Execute "DELETE FROM [Stage] WHERE ref_val = '" & ref_val & "';"

Const YOUR_TABLE_NAME   As String = "Stage"
Dim SQL_UPDATE_DATA   As String
SQL_UPDATE_DATA = "SELECT *, ';' & '" & ref_val & "' FROM [" & YOUR_TABLE_NAME & "] WHERE SR_Profit_Center Is Null"

Dim strF1Data   As String
Dim varData     As Variant

Set rs = CurrentDb.OpenRecordset(SQL_UPDATE_DATA)
With rs
    Do Until .EOF
        strF1Data = !ref_val
        varData = Split(strF1Data, ";")
        If UBound(varData) = 4 Then
            .Edit
            !ref_val = ref_val
            !UPC = varData(0)
            !SR_Profit_Center = varData(1)
            !SR_Super_Label = varData(2)
            !SAP_Profit_Center = varData(3)
            !SAP_Super_Label = varData(4)
            .Update
        End If
        .MoveNext
    Loop
    .Close
End With

Set rs = Nothing

End Sub

我也知道额外的可变部分，一旦我开始工作，我会清理它。

文件示例：

工作文件：

1. CE16041901
2. 00791558441123;US1K100017;CGR;US1K100001;未知
3. 00791558442328;US1K100017;CGR;US1K100001;未知
4. 00791558440720;US1K100017;CGR;US1K100001;未知
5. 00791558444629;US1K100017;CGR;US1K100001;未知
6. 00791558440522;US1K100017;CGR;US1K100001;未知
7. 00791558443325;US1K100017;CGR;US1K100001;未知

文件无效：

1. CE16042001
2. 00791558334128;US1K100017;CGR;US1K100001;未知
3. 00791558159523;US1K100017;CGR;US1K100001;未知
4. 00602547736604;US1A100018;UR;US1A100018;US-RU

感谢您的帮助。我尽可能地使用它，但在访问和 vb 方面我仍然是一个新手。如果您需要更多信息或澄清，请告诉我，我会尽力提供/解释。

Answer 1

无需接触临时表功能。只需有条件地填充 strFileList 数组，具体取决于 Excel 工作簿的第一个工作表是否包含 No Data 或空单元格。 Recall Access VBA 可以通过 COM 接口或 Excel VBA 引用完全访问所有 Excel 对象，因此可以迭代地打开工作簿。因此，相应地调整您的 While/Wend 循环：

Sub Pull_File_into_Staging_Table()

   '...same code...

   Dim objXL As Object
   Dim wb As Object

   Set objXL = CreateObject("Excel.Application")

   strfile = Dir(Path & "*.xls")
   While strfile <> ""

       Set wb = objXL.Workbooks.Open(Path & strfile)

       If wb.Sheets(1).Range("A1") <> "No Data" AND  wb.Sheets(1).Range("A1") <> "" Then
           'add files to the list
           intFile = intFile + 1
           ReDim Preserve strFileList(1 To intFile)
           strFileList(intFile) = strfile
       End If
       strfile = Dir()

       wb.Close False
       Set wb = Nothing
   Wend
'...