[英]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.