Fatal编程技术网
  • ms-access/
  • Ms access VBA访问：具有空值的文件

Ms access VBA访问：具有空值的文件

ms-access macros vba

Ms access VBA访问：具有空值的文件,ms-access,macros,vba,ms-access-2010,Ms Access,Macros,Vba,Ms Access 2010,总体目标： 从文件夹中取出所有文件>格式化暂存表中的文件>将暂存表复制到主表>杀死暂存表>冲洗并重复，直到所有文件都从文件夹中取出、格式化并放入主表 问题： 我显然没有考虑到发送给我的一些文件将有空白的工作表（相反，它们可能在单元格A1中有一个表示“无数据”的值）。当我的宏点击“无数据”或空白页时，我得到一个空错误（94） 我所尝试的： Sub Pull_File_into_Staging_Table() 'Process: '1 - Loop through all files sav

总体目标： 从文件夹中取出所有文件>格式化暂存表中的文件>将暂存表复制到主表>杀死暂存表>冲洗并重复，直到所有文件都从文件夹中取出、格式化并放入主表

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

我所尝试的：

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
  • strF1Data=Nz（！ref_val）
  • strF1Data=Nz（！ref_val，“”）
怀疑： 我想我可以更新SQL更新行以允许空值，但我觉得更有效的解决方案是在空值时跳过。然而，我试图修改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
另外，我知道额外的变量块，我会清理它一旦我得到它的工作

文件示例：

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
工作文件：

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；US1K10001；未知的
  • 00791558442328；US1K100017；CGR；US1K10001；未知的
  • 00791558440720；US1K100017；CGR；US1K10001；未知的
  • 00791558444629；US1K100017；CGR；US1K10001；未知的
  • 00791558440522；US1K100017；CGR；US1K10001；未知的
  • 00791558443325；US1K100017；CGR；US1K10001；未知的
    • 不工作文件：

    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
  • CE16042001
  • 00791558334128；US1K100017；CGR；US1K10001；未知的
  • 00791558159523；US1K100017；CGR；US1K10001；未知的
  • 00602547736604；US1A100018；乌尔；US1A100018；美国-俄罗斯
    • 谢谢你的帮助。我尽可能地使用它，但对于access和vb，我仍然是个新手。如果您需要更多信息或澄清，请让我知道，我将尽力提供/解释。

    无需触摸暂存表功能。根据Excel工作簿的第一张工作表是否不包含数据或空单元格，只需有条件地填充
    strFileList
    数组即可。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
'...

    Sub-Pull_文件_到_Staging_表（）
“…相同的代码。。。
作为对象的Dim objXL
作为对象的Dim wb
设置objXL=CreateObject（“Excel.Application”）
strfile=Dir（路径和“*.xls”）
而strfile“”
设置wb=objXL.Workbooks.Open（路径和strfile）
如果工作分解表（1）范围（“A1”）“无数据”和工作分解表（1）范围（“A1”）”，则
'将文件添加到列表中
intFile=intFile+1
ReDim保留strFileList（1到intFile）
strFileList（intFile）=strfile
如果结束
strfile=Dir（）
wb.关闭错误
设置wb=Nothing
温德
'...
    无需触摸暂存表功能。根据Excel工作簿的第一张工作表是否不包含数据或空单元格，只需有条件地填充
    strFileList
    数组即可。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
'...

    Sub-Pull_文件_到_Staging_表（）
“…相同的代码。。。
作为对象的Dim objXL
作为对象的Dim wb
设置objXL=CreateObject（“Excel.Application”）
strfile=Dir（路径和“*.xls”）
而strfile“”
设置wb=objXL.Workbooks.Open（路径和strfile）
如果工作分解表（1）范围（“A1”）“无数据”和工作分解表（1）范围（“A1”）”，则
'将文件添加到列表中
intFile=intFile+1
ReDim保留strFileList（1到intFile）
strFileList（intFile）=strfile
如果结束
strfile=Dir（）
wb.关闭错误
设置wb=Nothing
温德
'...
    它给了我一个424运行时错误，在线
    Set wb=Workbooks.Open（path&strFile）
    事实上，我把Access和Excel VBA混为一谈了。调用外部应用程序时，必须限定所有对象。请参阅使用
    objXL
    对象进行编辑。仍然无法进行编辑，但它会返回到
    strF1Data=！参考值
    再次编码。给出与之前相同的错误94。我将代码的
    wb.Sheets（1）.Range（“A1”）
    位修改为Sheets（day1）.Range（“A1”）…我尝试了两种方法。除了没有数据和空单元格之外，工作簿肯定还有另一个问题。为此，在后面的Do/Until循环中，在顶部添加
    debug.Print！参考值
    。重新运行代码，当代码出错时，检查VBA IDE的即时窗口，查看最后打印的文件。这就是问题所在，孩子。打开它并验证它出错的原因。它给了我一个424运行时错误，在线
    Set wb=Workbooks.Open（path&strFile）
    的确，我把Access和Excel VBA混为一谈了。调用外部应用程序时，必须限定所有对象。请参阅使用
    objXL
    对象进行编辑。仍然无法进行编辑，但它会返回到
    strF1Data=！参考值
    再次编码。给出与之前相同的错误94。我将代码的
    wb.Sheets（1）.Range（“A1”）
    位修改为Sheets（day1）.Range（“A1”）…我尝试了两种方法。除了没有数据和空单元格之外，工作簿肯定还有另一个问题。为此，在后面的Do/Until循环中，在顶部添加
    debug.Print！参考值
    。重新运行代码，当它出错时，检查VBA的IDE的即时窗口，查看最后一个文件是什么