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

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

1 个答案: