Question

总体目标： 从文件夹中拉出所有文件＆gt;格式化登台表格中的文件＆gt;将登台表复制到主表＆gt;杀死临时表＆gt;冲洗并重复，直到所有文件都从文件夹中取出，格式化并放入主表。

问题： 我显然没有考虑到发送给我的一些文件会有空白的工作表（相反，它们可能在单元格A1中有一个“无数据”的值）。当我的宏点击“无数据”或空白表时，我得到一个空值错误（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

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

文件示例：

工作档案

CE16041901
00791558441123; US1K100017; CGR; US1K100001; UNKNOW
00791558442328; US1K100017; CGR; US1K100001; UNKNOW
00791558440720; US1K100017; CGR; US1K100001; UNKNOW
00791558444629; US1K100017; CGR; US1K100001; UNKNOW
00791558440522; US1K100017; CGR; US1K100001; UNKNOW
00791558443325; US1K100017; CGR; US1K100001; UNKNOW

不工作文件：

CE16042001
00791558334128; US1K100017; CGR; US1K100001; UNKNOW
00791558159523; US1K100017; CGR; US1K100001; UNKNOW
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
'...

VBA访问：具有空值的文件

1 个答案: