[英]How to copy the content of columns inside a text file using VBA
所以我想从 Excel 文件中获取数据并将它们复制到一个文本文件中。 数据在三列上,我想用空格分隔列。 现在,我在带箭头的行上遇到bad file mode
错误。 在这里,我将留下困扰我的代码的特定部分以及我知道的所有代码,我应该将Open newfilepath For output As #1
而不是Open newfilepath For Input As #1
但它给了我错误 70 àcces在这里否认了困扰我的部分:
Set fSo = CreateObject("Scripting.FileSystemObject")
If Not fSo.FolderExists(Folder_path) Then
fSo.CreateFolder (Folder_path)
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + newfilename, True)
Open newfilepath For Input As #1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
For j = 8 To 10 'columns
cellValue = Rng.Cells(i, j).Value
If j = Columns.Count Then
Print #1, cellValue
Else
--> Print #1, cellValue,<--
End If
Next j
Next i
myFile.Close
Set fSo = Nothing
End If
Else
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + newfilename, True)
Open newfilepath For Input As #1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
For j = 8 To 10 'columns
cellValue = Cells(i, j).Value
If j = Columns.Count Then
Print #1, cellValue
Else
Print #1, cellValue
End If
Next j
Next i
myFile.Close
Set fSo = Nothing
End If
End If
这是我所有的代码:
Sub register_formated_data()
'
' register_formated_data Macro
'
Dim order As Object
Dim Folder As Object
Dim Folder_path As String
Dim lastrow As Long
Dim i, j As Integer
Dim newfilepath As String
Dim fSo As Object
Dim myFile As Object
Dim FL As String ' FL is for file location
Dim last_row As Long
newfilename = "formated " & Right(Sheets(8).Cells(6, 12).Value, Len(Sheets(8).Cells(6, 12).Value) - InStrRev(Sheets(8).Cells(6, 12).Value, "\"))
MsgBox newfilename, vbOKOnly, "name of the formated file"
FolderName = "Formated Files"
Sheets(8).Cells(12, 12).Value = ""
With Application.FileDialog(msoFileDialogFolderPicker) '
.Title = "Select where you want the folder to be" 'Open the file explorer
.InitialFileName = ThisWorkbook.path & "\" 'for you to select
.InitialView = msoFileDialogViewDetails 'the file you want
.AllowMultiSelect = True 'to add the txt file
.Show '
'On Error GoTo PROC_EXIT
If Not .SelectedItems(1) = vbNullString Then FL = .SelectedItems(1)
End With
Sheets(8).Cells(12, 12).Value = FL
Folder_path = FL + "\" + FolderName
newfilepath = Folder_path + "\" + newfilename
'myfilepath = Folder_path & "\" & newfilename
Set fSo = CreateObject("Scripting.FileSystemObject")
If Not fSo.FolderExists(Folder_path) Then
fSo.CreateFolder (Folder_path)
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + newfilename, True)
Open newfilepath For Input As #1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
For j = 8 To 10 'columns
cellValue = Rng.Cells(i, j).Value
If j = Columns.Count Then
Print #1, cellValue
Else
Print #1, cellValue,
End If
Next j
Next i
myFile.Close
Set fSo = Nothing
End If
Else
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + newfilename, True)
Open newfilepath For Input As #1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
For j = 8 To 10 'columns
cellValue = Cells(i, j).Value
If j = Columns.Count Then
Print #1, cellValue
Else
Print #1, cellValue
End If
Next j
Next i
myFile.Close
Set fSo = Nothing
End If
End If
PROC_EXIT:
End Sub
像这样尝试:
Dim ln As String, sep As String
'...
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(Folder_path) Then fso.CreateFolder Folder_path
Set myfile = fso.CreateTextFile(Folder_path + "\" + newfilename, True)
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
sep = "" '<< clear separator
ln = "" '<< clear line
For j = 8 To 10 'columns
ln = ln & sep & Rng.Cells(i, j).Value
sep = " " '<<< populate separator after first value
Next j
myfile.writeline ln
Next i
myfile.Close
Set fso = Nothing
'...
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.