I'm needing to export to a text file without " marks example
exporting this
Create bts; sitemask = "0110"; pcmlink = 40
exports like this
"Create bts; sitemask = ""0110""; pcmlink = 40"
This code I found for doing this works and strips off the " marks
Sub Export()
Dim r As Range, c As Range
Dim sTemp As String
Open "c:\MyOutput.txt" For Output As #1
For Each r In Selection.Rows
sTemp = ""
For Each c In r.Cells
sTemp = sTemp & c.Text & Chr(9)
Next c
'Get rid of trailing tabs
While Right(sTemp, 1) = Chr(9)
sTemp = Left(sTemp, Len(sTemp) - 1)
Wend
Print #1, sTemp
Next r
Close #1
End Sub
This code works from selecting the cells running the code which exports the current selected cells, my question is this how can I modify this code to work on a predefined cell range eg A1 to A10 for exporting rather than the current selection?
Also is there away to modify the file path to save in the same directory as the active excel sheet instead of having to put the full file path"C:\MyOutput.txt" instead "MyOutput.txt" (or something like that)?
Many thanks
The modification would be pretty obvious: assuming that your workbook is named "ThisWorbook.xls", and the worksheet that holds the range you want to write to file is named "This Worksheet", then you'll adapt the code like
' ... Previous original code
' Open file in the same folder as the worksheet
Open Workbooks("ThisWorbook.xls").Path & "\MyOutput.txt" For Output As #1
' Loop in predefined range instead of current selection
For Each r In Worksheets("This Worksheet").Range("A1:A10").Rows
' ... Following original code
Don't open it directly:
Sub Export()
Dim r As Range, c As Range
Dim sTemp As String
Dim fn As Long
Dim sfilename
sfilename = "C:\MyOutput.txt"
fn = FreeFile
Open sfilename For Output As #fn
For Each r In Selection.Rows
sTemp = ""
For Each c In r.Cells
sTemp = sTemp & c.Text & Chr(9)
Next c
'Get rid of trailing tabs
While Right(sTemp, 1) = Chr(9)
sTemp = Left(sTemp, Len(sTemp) - 1)
Wend
Print #fn, sTemp
Next r
Close #fn
End Sub
You have an excel file, and when You save the file as .txt the Quotation marks appear. Mark the data ( CTRL + A), copy the data to clipboard ( CTRL + C).
Open notepad, paste the data ( CTRL + V) save the data...
There, data without Quotation marks.
From what I've seen in VBA 2010, the Write function creates output with the unwanted wrapping quotation characters.
However the similar Print function writes to the file without the quotes.
But if you wanted quotes in the text file, you could create a string concatenation at the quote locations to add them in with Chr(39), eg.
For an output of:
Create bts; sitemask = "0110"; pcmlink = 40
Code as:
"Create bts; sitemask = " & Chr(39) & "0110" & Chr(39) & "; pcmlink = 40"
Save your file as ASCII file not unicode
fso.CreateTextFile(path, True, False)
Related
Hi there so I finished the section of a program which calculates and exports a csv with results. (ends up about 1600 csv files) each having only 1 column and between 20 and 0 rows. I would like my MS Access VBA program to join them together into one larger CSV. So Same header only once at the top of the new file.
The program i have so far seems to fall over at the part where it tries to import the Reg. Number of the File.
Dim db As DAO.Database
Set db = CurrentDb
MTH = Format(Date, "mmm")
UserInput = InputBox("Enter Country Code")
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Dim wks As Excel.Worksheet
Application.Echo False
'Change the path to the source folder accordingly
strSourcePath = "Q:\CCNMACS\AWD" & CTRY
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
'Change the path to the destination folder accordingly
strDestPath = "Q:\CCNMACS\AWDFIN"
If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1, strData
End If
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
wks.Cells(r, c + 1).Value = Trim(x(c)) 'Error is here: Run time error '91': Object variable or With Block variable not set
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strDestPath & strFile
strFile = Dir
Loop
Application.Echo True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation
Your question isn't absolutely definitive as to what you're trying to do, but if I understand correctly, you just need to append several files to the end of each other, to make "one big CSV".
If that's true then there are several ways to do this a lot simpler than using VBA. .CSV files are just plain text files with comma's separating each field, and a .CSV filename extension.
Personally I would use Notepad++ (I assume it's capable of this; it does everything else), or perhaps even easier, I would use the Windows Command Prompt.
Let's say you have a folder with files:
File1.csv
File2.csv
File3.csv
...etc
Open the Windows Command Prompt. (One way is with the Windows key + R, then type cmd and hit Enter.)
Change directory with to the file location using cd (same as ChDir).
(For example, you might use cd c:\users\myFolder,
and then hit Enter)
To combine all CSV's in the folder into one, you could use a command like:
copy *.csv combinedfile.csv
That's it!
A file is created named combinedfile.csv. You can open in Excel or a text editor (like Notepad) to double-check it and adjust manually if necessary.
Obviously there are many ways you could vary the command, like if you only wanted the files that start with the word File you could use:
copy file*.csv combinedFile.csv
This should do what you want.
Sub Import()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\your_path_here\"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "Table1"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, "", strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
See the links below for additional details pertaining to this topic.
https://anthonysmoak.com/2018/04/10/how-to-fix-an-import-specification-error-in-microsoft-access/
https://www.oakdome.com/programming/MSAccess_ExportSpecifications_TransferText_To_CSV.php
Whenever I run the macro text file is generated but there is space after every line., How do I fix it?
Here it is my code
Sub test()
Dim txt As String, i As Long, rng As Range
Set rng = Range("A1:C500")
For i = 1 To rng.Rows.Count
With WorksheetFunction
txt = txt & vbCrLf & Join(.Transpose(.Transpose(rng.Rows(i).Value)), vbTab)
End With
Next
Open "c:\test\test.txt" For Output As #1
Print #1, Mid$(txt, 2)
Close #1
End Sub
Try Triming the text. The code should be something like this:
txt = txt & vbCrLf & Trim(Join(.Transpose(.Transpose(rng.Rows(i).Value)), vbTab))
I am trying to write a macro whereby it checks all sheetnames for certain criteria (specifically here the inclusion of 'TUBA' in the name) and, if met, exports a range on those sheets to text files with the sheet name as filename. I am getting error 91: object variable or With block variable not set, and on debugging the If WS.name Like "TUBA*" Then line is highlighted. How can I fix this? The problematic code is below. I previously had success with almost the same code but without the If statement (shown in the second block below), so I assume its the way I am adding this in. If i need to set a variable, which one have i missed?
Sub ExportTubatoText()
Dim c As Range, r As Range
Dim output As String
Dim lngcount As Long
Dim WS As Worksheet
Dim Name As String
Dim strFolder As String
strFolder = GetFolder("L:TUBA\")
'\ dialog box opens in that folder as default
'strFolder = GetFolder("L:TUBA\")
If strFolder <> "" Then
MsgBox strFolder
End If
For Each sh In ThisWorkbook.Worksheets
'if worksheet has 'TUBA' in the title, then it is exported to text
If WS.Name Like "TUBA*" Then
output = ""
For Each r In sh.Range("F3:F200").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Name = sh.Name
Open strFolder & "\" & Name & ".txt" For Output As #1
Print #1, output
Close
End If
Next
End Sub
Successful code:
For Each sh In ThisWorkbook.Worksheets
output = ""
For Each r In sh.Range("O2:O500").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Name = sh.Name
Open strFolder & "\" & Name & ".txt" For Output As #1
Print #1, output
Close
Next
Try changing
If WS.Name Like "TUBA*" Then
to
If sh.Name Like "TUBA*" Then
Or change your For Each to WS in...
Note: this is just an idea and not an answer as #Rdster explain why your first code dos not work.
If you are working with only one column (like your both codes do) you can replace this part of your code:
For Each r In sh.Range("F3:F200").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
with this line:
output = Join(Application.Transpose(sh.Range("F3:F200").Value), vbNewLine)
I have a source spreadsheet in Excel with 450-or-so rows. Each row has 6 columns of data, and I need to create a separate file from each row with the filename = Column A and the contents = Columns B-G with a line break between them.
For example, I'm trying this but getting an error "File not found":
Sub DataDump()
Dim X
Dim lngRow As Long
Dim StrFolder As String
StrFolder = "/Users/danielfowler/Documents/_users_text_6.16"
X = Range([a1], Cells(Rows.Count, 2).End(xlUp))
For lngRow = 1 To UBound(X)
Open StrFolder & "\" & X(lngRow, 1) & ".txt" For Output As #1
Write #1, X(lngRow, 2)
Close #1
Next
End Sub
I see a half dozen questions like this already here on StackOverflow...
Create text Files from every row in an Excel spreadsheet
Write each Excel row to new .txt file with ColumnA as file name
Outputting Excel rows to a series of text files with spaces in filenames using VBA
Outputting Excel rows to a series of text files
But every one of these solutions returns a different error for me. I'm using Excel for Mac 2011, v14.4.2.
Sub VBA_Print_to_a_text_file()
Dim strFile_Path As String
strFile_Path = "C:\temp\test.txt" ‘Change as per your test folder path
Open strFile_Path For Output As #1
Print #1, "This is my sample text"
Close #1
End Sub
This outputs a text file for each row with column A as the title and columns B to the last column as the content for each file. You can change the directory to whatever you want but currently it saves the text file(s) to the same directory as the Excel file. You can also change the file extension to whatever you want.
Sub toFile()
Dim FilePath As String, CellData As String, LastCol As Long, LastRow As Long
Dim Filenum As Integer
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To LastRow
FilePath = Application.DefaultFilePath & "\" & Trim(ActiveSheet.Cells(i, 1).Value) & ".xpd"
Filenum = FreeFile
Open FilePath For Output As Filenum
CellData = ""
For j = 2 To LastCol
CellData = Trim(ActiveSheet.Cells(i, j).Value)
Write #Filenum, CellData
Next j
Close #Filenum
Next i
MsgBox ("Done")
End Sub
As for the breaks in between each line, unfortunately I'm not experienced enough to know how to do that.
I have a Word document that contains a table with 3 columns. I'm trying to create a macro that will open a pdf file (name stored in columns 2) at the page number in column 3.
I found a macro in Excel that will open it automatically when I select the page number cell, but nothing in Word. Lots of users are using the Word document and don't want to switch to Excel.
Best will be to activate the macro with a keybord shortcut and if in the table, it will open the file at the page specified in the row where the cursor is. If cursor is not in the table, an error could show.
Thanks.
[EDIT]
Here is the code for the Excel macro. Note that the Adobe Reader path and program is store in cell B1 and the file is in cell B2 in this example.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row > 4 And Target.Column = 1 And Target.Value > 0 Then
vAdobe = ActiveSheet.Cells(1, 2)
vDocument = ActiveSheet.Cells(2, 2)
vPage = Target.Value
result = Shell(vAdobe & " /A ""page=" & vPage & """ " & vDocument, vbNormalFocus)
End If
End Sub
Here's one way:
Sub OpenPDF()
Dim aRow As Row
Dim vDocument As String
Dim vPage As String
Dim vAdobe As String
Dim result As Long
vAdobe = <File path to Acrobat.exe here.>
If Selection.Information(wdWithInTable) = True Then
Set aRow = Selection.Range.Rows(1)
vDocument = Trim(Replace(Replace(aRow.Cells(2).Range.Text, "", ""), vbCr, ""))
vPage = Trim(Replace(Replace(aRow.Cells(3).Range.Text, "", ""), vbCr, ""))
result = Shell(vAdobe & " /A ""page=" & vPage & """ " & vDocument, vbNormalFocus)
Else: 'Some error message here.
End If
End Sub
You may need to play with those Replace methods; I found it necessary to remove some table characters that were appearing at the end of any text pulled from the table cell.
Another option that requires setting a reference can be found here: http://www.myengineeringworld.net/2012/07/vba-macro-to-open-pdf-file.html