ワークシートの行と列を削除するMSAccess VBA

Question

dirに常駐するHundreds xlsxファイルはMSAccess 2010データベース にインポートされますが、通常どおりユーザーは扱いにくい（爆弾が必要です...）ので、インポートする前にワークシートをクリーニングしてください。質問は：列Aのデータを持たないすべての行と、OからXFDまでのすべての列を削除する方法は？ 以下のコードは動作しますが、1つのファイルにつき1回限りです。事前に感謝の意を表します。 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列にデータを持っているファイル用のチェックはありません - それが起こる場合は、プログラムが使い尽くされてい すべての行まで続きます。

EDIT - 最後の非空のセルまでのすべての空行を削除する修正は

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