Question

我很抱歉这很简单，但是我对VBA的经验绝对为零，我在前进的过程中遇到了一些障碍。我已经弄清楚了如何从文本导入文件并根据需要使用record macro函数将其转换。我现在正在寻找基于文件名变量的循环此过程。我要导入的文件将使用命名约定AB1，AB2，AB3等，或者等同于任意名称，一旦导入文件并将其转换为格式代码，它将在新页面上重复该过程。

我已经尝试了许多网站上的各种编码框架，但是我永远无法成功将其集成到我的代码中。

Sub LoadFromFile()
Dim fileName As String, folder As String

folder = "FILEPATH
fileName = ActiveCell.Value

ActiveCell.Offset(1, 0).Range("A1").Select

With ActiveSheet.QueryTables _
    .Add(Connection:="TEXT;" & folder & fileName, 
Destination:=ActiveCell)
    .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 = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
Cells.Select
With Selection.Font
    .Name = "Lucida Console"
    .Size = 8
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone

End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup
  .Orientation = xlLandscape
       .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.75)
    .BottomMargin = Application.InchesToPoints(0.75)
    .HeaderMargin = Application.InchesToPoints(0.3)
    .FooterMargin = Application.InchesToPoints(0.3)
End With
Application.PrintCommunication = True

End Sub

Answer 1

如果文件都在同一个文件夹中，则可以使用类似的功能来删除该文件夹中所有文件的名称

Function listfiles(ByVal sPath As String)

    Dim vaArray     As Variant
    Dim i           As Integer
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        vaArray(i) = oFile.Name
        i = i + 1
    Next

    listfiles = vaArray

End Function

然后您可以执行“ For Each”以获取每个文件并在其中运行代码。

祝你好运

根据名称变量导入文件循环

1 个答案: