将文件导入Excel - 如果找不到，请跳过 [英] Importing Files Into Excel - Skip if not Found

问题描述

这是我的第一个问题，我有一个宏将.txt文件分号分隔成Excel。每个文件都是特定的名称，每个文件都会导入到新的表格中。但是如果这些文件中的一个不存在，宏就会失败。我想添加一个On Erro来处理这些情况，如果该文件不存在，请跳过它。代码：

  Sub Importar_Dep（）
 
 Dim Caminho As String 
 
 
 Caminho = Sheets（DADOS）。Cells（5,8）.Value 
 Sheets（DEP）。选择
使用ActiveSheet.QueryTables.Add（Connection：= _ 
TEXT;& Caminho，_ 
目的地：=范围（$ A $ 1））
 .Name =RECONQUISTA_DEP_0
 .FieldNames = True 
 .RowNumbers = False 
 .FillAdjacentFormulas = False 
 .PreserveFormatting = True 
 .RefreshOnFileOpen = False 
 .RefreshStyle = xlInsertDeleteCells 
 .SavePassword = False 
。 SaveData = True 
 .AdjustColumnWidth = True 
 .RefreshPeriod = 0 
 .TextFilePromptOnRefresh = False 
 .TextFilePlatform = 850 
 .TextFileStartRow = 1 
 .TextFileParseType = xlDelimited 
 .TextFileTextQualifier = xlTextQualifierDoubleQuote 
 .TextFileConsecutiveDe limiter = False 
 .TextFileTabDelimiter = False 
 .TextFileSemicolonDelimiter = True 
 .TextFileCommaDelimiter = False 
 .TextFileSpaceDelimiter = False 
 .TextFileColumnDataTypes = Array（1，1，1， 1，1，1，1，1）
 .TextFileTrailingMinusNumbers = True 
 .Refresh BackgroundQuery：= False 
 End with 
 End Sub 
  

解决方案

这是您的代码，检查文件是否存在：

  Sub Importar_Dep（）
 
 Dim Caminho As String 
 Caminho = Sheets（DADOS）。Cells（5，8）选择
 
'+++++添加块来检查文件是否存在+++++ 
 Dim FS 
设置FS = CreateObject（Scripting.FileSystemObject）
 
 Dim TextFile_FullPath As String 
'textfile_fullPath应如下所示：
 TextFile_FullPath =C：\Users\Username\\ \\ Desktop\&am磷; _ 
 RECONQUISTA_DEP_0& _ 
.txt
 
如果FS.FileExists（TextFile_FullPath）然后
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ & Caminho，_ 
目的地：=范围（$ A $ 1））
 .Name =RECONQUISTA_DEP_0
 .FieldNames = True 
 .RowNumbers = False 
 .FillAdjacentFormulas = False 
 .PreserveFormatting = True 
 .RefreshOnFileOpen = False 
 .RefreshStyle = xlInsertDeleteCells 
 .SavePassword = False 
 .SaveData = True 
 .AdjustColumnWidth = True 
 .RefreshPeriod = 0 
 .TextFilePromptOnRefresh = False 
 .TextFilePlatform = 850 
 .TextFileStartRow = 1 
 .TextFileParseType = xlDelimited 
 .TextFileTextQualifier = xlTextQualifierD oubleQuote 
 .TextFileConsecutiveDelimiter = False 
 .TextFileTabDelimiter = False 
 .TextFileSemicolonDelimiter = True 
 .TextFileCommaDelimiter = False 
 .TextFileSpaceDelimiter = False 
 .TextFileColumnDataTypes = Array 1，1，1，1，1，1，1）
 .TextFileTrailingMinusNumbers = True 
 .Refresh BackgroundQuery：= False 
结束
 
结束If 
 
 End Sub 
  

像你的评论一样，如果你想跑所有具有相同名称的文件（过滤器），您可以使用此代码。上述修改后来变得无用，因为这样你就不用再检查文件是否存在，因为它只会通过所有现有的文件。您可能需要检查文件夹是否存在：

  Sub RunThroughAllFiles（）
 
 Dim Caminho As String 
 Caminho = Sheets（DADOS）。单元格（5,8）.Value 
表格（DEP）。选择
 
 Dim FS 
设置FS = CreateObject（Scripting.FileSystemObject）
 
 Dim Filter As String：Filter =RECONQUISTA_DEP _ *。txt
 Dim dirTmp As String 
 
如果FS.FolderExists （Caminho）然后
 dirTmp = Dir（Caminho&\& Filter）
 Do While Len（dirTmp）> 0 
调用Importar_Dep（Caminho&\& dirTmp，_ 
 Left（dirTmp，InStrRev（dirTmp，。） -  1））
 dirTmp = Dir 
 Loop 
 Else 
 MsgBoxFolder& Caminho& 不存在，vbExclamation 
 End If 
 
 End Sub 
 
 Sub Importar_Dep（iFullFilePath As String，iFileNameWithoutExtension）
 
使用ActiveSheet.QueryTables.Add（Connection：= _ 
TEXT;& iFullFilePath，_ 
 Destination：= Range（$ A $ 1）
 .Name = iFileNameWithoutExtension 
 .FieldNames = True 
 .RowNumbers = False 
 .FillAdjacentFormulas = False 
 .PreserveFormatting = True 
 .RefreshOnFileOpen = False 
 .RefreshStyle = xlInsertDeleteCells 
 .SavePassword = False 
 .SaveData = True 
 .AdjustColumnWidth = True 
 .RefreshPeriod = 0 
 .TextFilePromptOnRefresh = False 
 .TextFilePlatform = 850 
 .TextFileStartRow = 1 
 .TextFileParseType = xlDelimited 
 .TextFileTextQualifier = xlTextQualifierDoubleQuote 
 .TextFileConsecutiveDelimiter = False 
 .TextFileTabDelimiter = False 
 .TextFileSemicolonDelimiter = True 
 .TextFileCommaDelimiter = False 
 .TextFileSpaceDelimiter = False 
 .TextFileColumnDataTypes = Array（1，1，1，1，1， 1，1，1）
 .TextFileTrailingMinusNumbers = True 
 .Refresh BackgroundQuery：= False 
 End with 
 
 End Sub 
  

有关详细信息，请参阅 目录， FileExists 和 FolderExists

This is my first question here, I have a macro to import .txt files "Semicolon" delimited into Excel. Each file is name specific, and each file is imported in a new sheet. But if one of theses files doesn't exists, the macro Fails. I want to add an "On Erro" to handle these cases, if the file doesn't exists, skip it. Heres the code:

Sub Importar_Dep()

Dim Caminho As String


Caminho = Sheets("DADOS").Cells(5, 8).Value
    Sheets("DEP").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Caminho, _
        Destination:=Range("$A$1"))
        .Name = "RECONQUISTA_DEP_0"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

解决方案

Here is your code with the check if the file exist:

Sub Importar_Dep()

    Dim Caminho As String
    Caminho = Sheets("DADOS").Cells(5, 8).Value
    Sheets("DEP").Select

    '+++++ Added block to check if file exists +++++
    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

    Dim TextFile_FullPath As String
    'The textfile_fullPath should be like:
    TextFile_FullPath = "C:\Users\Username\Desktop\" & _
                         RECONQUISTA_DEP_0 & _
                         ".txt"

    If FS.FileExists(TextFile_FullPath) Then
    '++++++++++++++++++++++++++++++++++++++++++++++++
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & Caminho, _
            Destination:=Range("$A$1"))
            .Name = "RECONQUISTA_DEP_0"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

    End If

End Sub

Like in your comment, if you want to run through all files that have a certain name in common (a filter), you can use this code. The above modifications have then became useless because with this you don't have to check if file exists anymore since it will just go through all existing files. You could have to check if the folder exists though:

Sub RunThroughAllFiles()

    Dim Caminho As String
    Caminho = Sheets("DADOS").Cells(5, 8).Value
    Sheets("DEP").Select

    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

    Dim Filter As String: Filter = "RECONQUISTA_DEP_*.txt"
    Dim dirTmp As String

    If FS.FolderExists(Caminho) Then
        dirTmp = Dir(Caminho & "\" & Filter)
        Do While Len(dirTmp) > 0
            Call Importar_Dep(Caminho & "\" & dirTmp, _
                            Left(dirTmp, InStrRev(dirTmp, ".") - 1))
            dirTmp = Dir
        Loop
    Else
        MsgBox "Folder """ & Caminho & """ does not exists", vbExclamation
    End If

End Sub

Sub Importar_Dep(iFullFilePath As String, iFileNameWithoutExtension)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & iFullFilePath, _
        Destination:=Range("$A$1"))
        .Name = iFileNameWithoutExtension
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

For more information see Dir, FileExists and FolderExists

这篇关于将文件导入Excel - 如果找不到，请跳过的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！