在excel vba中仅打开一次文本文件

Question

我有下面的代码，该代码从一列中打印文本，但多次打开文本文件，而不是一次。 请让我知道怎么了。 当我在Visual Basic调试模式下运行sub时，它只打开一次文本文件。 但是我在另一个宏之后调用这个宏，而那个时候它多次打开（相同）文本文件。

Sub createdevtest()
Dim filename As String, lineText As String
Dim data As Range
Dim myrng As Range, i, j

' filename = ThisWorkbook.Path & "\textfile-" & Format(Now, "ddmmyy-hhmmss") & ".txt"
 filename = ThisWorkbook.Path & "\devtest" & ".txt"

Open filename For Output As #1
Dim LastRow As Long
'Find the last non-blank cell in column A(1)
 LastRow = Cells(Rows.count, 1).End(xlUp).Row
Range("B4:B" & LastRow).Select
Set myrng = Selection

For i = 1 To myrng.Rows.count
    For j = 1 To myrng.Columns.count
        lineText = IIf(j = 1, "", lineText & ",") & myrng.Cells(i, j)
    Next j
    Print #1, lineText
Next i

Close #1
Range("B4").Select
' open devtest
'Shell "explorer.exe" & " " & ThisWorkbook.Path, vbNormalFocus
filename = Shell("Notepad.exe " & filename, vbNormalFocus)
End Sub

Answer 1

谢谢@Luuklag。 我曾尝试自己弄清楚，但没有成功。 发表评论后，只需再次遍历代码并获得线索。

下面是正确的代码，在其中我调用了其中一个宏（devtest1），其中包含上述文本文件创建宏（createdevtest）。 在更正之前，我在函数中而不是在Sub中调用宏，因此它再次循环并多次打开txt文件。

' macro to select folder and list files
Sub GetFileNames_devtest()
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)

' call devtest: corrected to call macro at right place
devtest1
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
'' Was calling wrongly macro here
End Sub
Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function
End Function