MSAccess VBA刪除工作表中的行和列

Question

駐留在目錄中的數百個xlsx文件導入到MSAccess 2010數據庫 中，但用戶像往常一樣不穩定（需要炸彈...），所以我必須清理工作表才能導入。問題是：如何刪除列A中沒有數據的所有行以及從O到XFD的所有列？ 下面的代碼工作，但只是一個文件一次，感謝提前任何幫助。 enter image description here 必須刪除全部紅色。

Private Sub Comand_Click() 
    Dim FullPath As String 
    Dim oXL As Object, oWb As Object, oWs As Object 
    FullPath = "D:\Access\_Test_XlsImport\FileName.xlsx" 
    Set oXL = CreateObject("Excel.Application") 
    Set oWb = oXL.Workbooks.Open(FullPath) 
    Set oWs = oWb.Sheets("Worksheet_name") 
    oXL.Visible = True 

    With oWs 
     .Columns("O:XFD").Delete 
     .Rows("xx:xx").Delete ' <---problem to identify the starting point to delete below.. 
    End With 
    oWb.Save 

CleanUp: 
    oWb.Close False 
    oXL.Quit 
    Set oWb = Nothing 
    Set oXL = Nothing 
    Set oWs = Nothing 
End Sub 

Answer 1

我將拉出oXL變量並將其設置爲全局模式，以便您只打開一次。

然後把其他Excel對象到其清潔工作表

像這樣的東西應該工作的子程序 - 替換您的文件夾爲恆 dir命令只匹配匹配XLSX文件規範和處理每個所有文件他們在循環

只是一個警告 - 有沒有檢查是否有在 A列中沒有數據文件 - 如果出現這種情況，程序將繼續進行，直到 已經用盡所有行。

編輯 - 修改最多刪除所有空行，直到最後一個非空單元格

Option Compare Database 
Option Explicit 


' Use these as global 
Private oXL As Object 

Private Sub Comand_Click() 

    Const SEARCH_FOLDER  As String = "C:\Databases\" 
    Const EXCEL_FILES  As String = "*.xlsx" 

    Dim FullPath As String 

    Dim strExcelFolder As String 
    Dim strFilename  As String 

    ' Open Excel 
    Set oXL = CreateObject("Excel.Application") 
    oXL.Visible = True 

    strFilename = Dir(SEARCH_FOLDER & EXCEL_FILES) 
    While strFilename <> "" 
     ProcessExcelFile SEARCH_FOLDER, strFilename 
     strFilename = Dir() 
    Wend 

CleanUp: 
    oXL.Quit 
    Set oXL = Nothing 
End Sub 

Private Sub ProcessExcelFile(strExcelFolder As String, strExcelFile As String) 

    Dim oWb As Object, oWs As Object 
    Dim strFullPath As String 

    Dim LastRow As Long 

    strFullPath = strExcelFolder & strExcelFile 
    Set oWb = oXL.Workbooks.Open(strFullPath) 
    Set oWs = oWb.Sheets(1) 

    With oWs 
     LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row 

     .Columns("O:XFD").Delete 

     ' Select All rows in Column A up to last filled row 
     .Range(「A1:A" & LastRow).Select 

     ' Delete all rows with empty cell in A - up to last filled row 
     oXL.Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

     .Save 
     .Close False 
    End With 

    Set oWb = Nothing 
    Set oWs = Nothing 

End Sub