Делать, пока контроль ошибок для Excel VBA Import - PullRequest
0 голосов
/ 09 декабря 2010

Я использую следующий код для импорта всех файлов CSV из D: \ Report в Excel с каждым файлом на новом листе с именем файла в качестве имени листа.

Я хочу включить контроль ошибок, чтобы код мог запускаться второй раз, если файл не был в каталоге отчетов. В настоящее время проблема заключается в том, что код будет запущен снова, но бомбить не удастся, поскольку у вас не может быть одинакового имени для двух листов, и я не хочу, чтобы одни и те же файлы снова импортировались.

    Sub ImportAllReportData()
'
' Import All Report Data
' All files in D:\Report will be imported and added to seperate sheets using the file names in UPPERCASE
'
Dim strPath As String
Dim strFile As String
'
strPath = "D:\New\"
strFile = Dir(strPath & "*.csv")
Do While strFile <> ""
    With ActiveWorkbook.Worksheets.Add
        With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
        Destination:=.Range("A1"))
        .Parent.Name = Replace(UCase(strFile), ".CSV", "")
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        End With
    End With
strFile = Dir
Loop
End Sub

Любая помощь будет принята с благодарностью

1 Ответ

2 голосов
/ 09 декабря 2010

Используйте следующую функцию , чтобы проверить, существует ли уже WS:

Function SheetExists(strShtName As String) As Boolean 
Dim ws As Worksheet 
    SheetExists = False 'initialise 
    On Error Resume Next 
    Set ws = Sheets(strShtName) 
    If Not ws Is Nothing Then SheetExists = True 
    Set ws = Nothing 'release memory 
    On Error GoTo 0 
End Function

Используйте его в своем коде так:

....
strPath = "D:\New\"
strFile = Dir(strPath & "*.csv")
Do While strFile <> ""
    If Not SheetExists(Replace(UCase(strFile), ".CSV", "")) Then

      With ActiveWorkbook.Worksheets.Add
        With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
        .....
    End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...