First post on this forum and I'm new to VBA so I will be as detailed as I can.
I've made a macro that modifies dxf drawing templates inside an excel tab and then writes that data to a new dxf file. I'm currently writing the text file with the code below:
Dim Application2 As Variant
Range("A:A").Copy
Application2 = Shell("c:\windows\notepad.exe", vbMaximizedFocus)
AppActivate Application2
SendKeys "^(V)", True
SendKeys "%fa", True
SendKeys "%t", True
SendKeys "{DOWN 2}", True
SendKeys "%n", True
SendKeys savetarget, True
SendKeys "%s", True
SendKeys "%fx", True
I've been trying to change to the method below so I don't need to open notepad and put in keystrokes.
FN = FreeFile
Open savetarget For Output Shared As #FN
For iCntr = 1 To copy_endline
mystring = workspace.Range("A" & iCntr).Value
Print #FN, mystring
mystring = ""
Next iCntr
Close #FN
This worked sometimes but it seems to modify the formatting somehow so the drawing becomes not readable to Autocad. If I manually copy the data from Row A and paste it into a notepad document it works fine.
I was able to fix my issue by using code from this post:
How to save particular column data of an excel worksheet to .txt file including line breaks in each cell content
I would thank them but I don't have enough reputation. haha
This while write a dxf file from data in one column in excel.
Mine looks something like this:
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(SaveLocation & DWG_Name & ".dxf", True)
nLastrow = Cells(Rows.Count, "A").End(xlUp).Row
nFirstRow = 1
For N = nFirstRow To nLastrow
t = Cells(N, "A").Text
a.WriteLine (t)
Next
a.Close
Related
I'm trying to create a text file from an Access Database that looks exactly like this:
CADWorx P&ID Drop Down List Configuration File.
Notes:
-This file contains information on what
appears in the drop down list in the
CEDIT Additional Data Dialog
-Entries should be separated by a semi-colon (;)
-If a value is not set, an edit box will appear
in the CEDIT Additional Data Dialog instead
of a drop down list.
-Example: AREA_=031;032;033;034A;034B;
Example: SERVICE_=AEC;HW;LH;CCH;
[DOCUMENTATION]
TYPE_=
DATESUB_=
DATEAPR_=
CREATEBY_=
APRBY_=
[LINE]
SERVICE_=OIL;FUEL GAS;
AREA_=
UNIT_=
COUNT_=
TYPE_=
RATING_=
FLGFACE_=
DESIGNPSI_=
DESIGNDEG_=
LINE_NUM_=
OPERPSI_=
OPERDEG_=
SPECPRESS_=
SPECTEMP_=
MINDEG_=
TESTPSI_=
INSULATE_=
HEATTRACE_=
XRAY_=
CODE_=
JOINTEFF_=
WELDPROC_=
INSPECT_=
MATPIPE_=
COMPNOTE_=
NOTE_=
USER1_=
All the fields on the left (that end with '_=') are field titles in my database.Then as explained above, values for those fields must be added and separated by a semicolon. I've been researching for over a week and pretty much just hitting dead ends with text file customization in Access. Can someone tell me if this is the way to go? Or should I export the data to Excel and create the text file from there?
Your help is very much appreciated. Thanks in advance.
Here's the basics to write records to a file:
Dim dbs As Database
Dim rst As Recordset
Dim intFileDesc As Integer 'File descriptor for output file (number used by OS)
Dim strOutput As String 'Output string for entry
Dim strRecordSource As String 'Source for recordset, can be SQL, table, or saved query
Dim strOutfile As String 'Full path to output file
Kill strOutfile 'Delete the output file before using it.
'Not necessary, but ensures you have a clean copy every time
intFileDesc = FreeFile 'Get a free file descriptor
Open strOutfile For Binary As #intFileDesc 'Open the output file for writing
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strRecordSource ) 'open the recordset based on our source string
With rst 'make things easier for ourselves
While Not .EOF
strOutput = !Field1 & ";" & !Field2 & ";" & !Field3
Print #intFileDesc, strOutput 'Print output string to file
.MoveNext 'Advance to next record in recordset
Wend
.Close 'Close this recordset
End With
Close #intFileDesc 'Close output file
Set rst = Nothing
Set dbs = Nothing 'Garbage handling before we exit the function
The essential line is this:
Print #intFileDesc, strOutput 'Print output string to file
by which you can write one line at a time.
Thus, build a function that expands on this, creating your output line by line (including empty lines for spacing) until done. That's it.
It takes a lot of code but really is quite trivial. And there is no other way for outputs like these.
I'm writing a query to extract text that was entered through a vendor-created word processor to an Oracle database and I need to export it to Word or Excel. The text is entered into a memo field and the text is intertwined with codes that the word processor uses for different functions (bold, indent, hard return, font size, etc.).
I've used the replace function to parse out a lot of the more common codes, but there are so many variations, it's nearly impossible to catch them all. Is there a way to do this? Unfortunately, I'm limited to using Microsoft Access 2010 to try and accomplish this.
The common thread I've found is that all the codes start with a back-slash and I'd like to be able to delete all strings that start with a back-slash up to the next space so all the codes are stripped out of the final text.
Here's a brief example of the text I'm working with:
{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fnil\fcharset0 Times New Roman;
\viewkind4\uc1\pard\f0\fs36 An abbreviated survey was conducted
on 02/02/15 to investigate complaint #OK000227. \par
No deficiencies were cited.\par
\fs20\par
}}
If your machine has Microsoft Word installed then you already have an RTF parser available so you don't have to "roll your own". You can just get Word to open the RTF document and save it as plain text like this:
Option Compare Database
Option Explicit
Public Function RtfToPlainText(rtfText As Variant) As Variant
Dim rtn As Variant
Dim tempFolder As String, rtfPath As String, txtPath As String
Dim fso As Object ' FileSystemObject
Dim f As Object ' TextStream
Dim wordApp As Object ' Word.Application
Dim wordDoc As Object ' Word.Document
Dim tempFileName As String
tempFileName = "~RtfToPlainText"
If IsNull(rtfText) Then
rtn = Null
Else
' save RTF text as file
Set fso = CreateObject("Scripting.FileSystemObject")
tempFolder = fso.GetSpecialFolder(2) ' Temporaryfolder
rtfPath = tempFolder & "\" & tempFileName & ".rtf"
Set f = fso.CreateTextFile(rtfPath)
f.Write rtfText
f.Close
Set f = Nothing
' open in Word and save as plain text
Set wordApp = CreateObject("Word.Application")
Set wordDoc = wordApp.Documents.Open(rtfPath)
txtPath = tempFolder & "\" & tempFileName & ".txt"
wordDoc.SaveAs2 txtPath, 2 ' wdFormatText
wordDoc.Close False
Set wordDoc = Nothing
wordApp.Quit False
Set wordApp = Nothing
fso.DeleteFile rtfPath
' retrieve plain text
Set f = fso.OpenTextFile(txtPath)
rtn = f.ReadAll
f.Close
Set f = Nothing
fso.DeleteFile txtPath
Set fso = Nothing
End If
RtfToPlainText = rtn
End Function
Then, if you had a table with two Memo fields - [rtfText] and [plainText] - you could extract the plain text into the second Memo field using the following query in Access:
UPDATE rtfTestTable SET plainText = RtfToPlainText([rtfText]);
The text you are working with is RTF. Here is a tutorial about the file format.
This link (on another site, registration required) may give you copy & paste code you can use to convert rtf fields to txt.
You may be able to copy the value of the field from the database and paste it into notepad and then save the notepad file as "test.rtf"...you could then double click the file icon and the document may open.
RTF is an old MS file format that allows formatting of text. See this wikipedia page.
I have a .CSV File with 5 values in a row , i want to modify the file in a way i should add one more value in the Beginning/End/Middle of the row.
How to add a new row with a set of values in the .CSV File?
How to do this in a simple way?
There is no magic way to insert things into the middle of a stream file (such as any text file including CSV files).
So this means you need to read the old file and modify it as you go writing a new file out.
There are many ways to do this though:
Read the input file into memory as a blob and work on it there then write out the modified data.
Read/write it with changes line by line.
Use Jet Text IISAM, Log Parser's COM API, etc. which allow SQL and SQL-like operations on text data in tabular formats such as CSV.
The simplest and most general way is line by line read/modify/write. This can be slower than the "blob" approach for small to middling files but doesn't risk the headaches that may result when a large file must be processed.
For very large files this can be optimized by reading, parsing, modifying, then writing in "chunks" to minimize I/O costs. But this can also be more complex to program correctly.
This piece of code may help , this is not an answer but it will help
Dim line As String
Dim arrayOfElements() As String
Dim linenumber As Integer
Dim i As Integer
Dim opLine As String
Dim fso As New FileSystemObject
Dim ts As TextStream
line = ""
Open strPath For Input As #1 ' Open file for input
Do While Not EOF(1) ' Loop until end of file
linenumber = linenumber + 1
Line Input #1, line
arrayOfElements = Split(line, "|")
If Not linenumber = 1 Then
If UBound(arrayOfElements) = 2 Then
line = line & "|x|y"
opLine = opLine & line & vbCrLf
End If
Else
line = line & "|col4|col5"
opLine = opLine & line & vbCrLf
End If
Loop
Close #1 ' Close file.
Set ts = fso.CreateTextFile(strPath, True)
ts.WriteLine (opLine)
ts.Close
fso need to be closed!
Set fso = Nothing
This question is very similar to the previously posted question: Save each sheet in a workbook to separate CSV files
However, my requirements are slightly different in that I need to have the ability to ignore specifically named worksheets (see #2 below).
I have been successful in utilizing the solution posted in this answer: https://stackoverflow.com/a/845345/1289884 which was posted in response to the question above meets almost all of my requirements with the exception of #2 below and #3 below:
I have an excel 2010 workbook that consists of multiple worksheets and I am looking for a macro that will:
Save each worksheet to a separate comma delimited CSV file.
Ignore specific named worksheet(s) (i.e. a sheet named TOC and sheet name Lookup)
Save files to a specified folder (example: c:\csv)
Ideal Solution would additionally:
Create a zip file consisting of all of the CSV worksheets within a specified folder
Any help would be greatly appreciated.
Nick,
Given you expanded on your question with the differences, and the zip part is a significant addon I have outlined a solution below that:
Creates the CSV file, skipping specific sheets using this line Case "TOC", "Lookup"
Adds them to a Zip file. This section draws heavily on Ron de Bruin's code here
The code will create the paths under StrMain and StrZipped if they do not already exists
As the ActiveWorkbook gets sub-divided into CSV files the code tests that the ActiveWorkbook is saved prior to proceeding
On (2) I ran across an issue I have seen before in my Produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folde where the Shell.Application errored when string variables were passed to it. So I gritted my teeth and added a hardcoding of the earlier paths for Zip_All_Files_in_Folder. I commented out my earlier variable passing to show where I tried this
VBA to save CSVS
Public Sub SaveWorksheetsAsCsv()
Dim ws As Worksheet
Dim strMain As String
Dim strZipped As String
Dim strZipFile As String
Dim lngCalc As Long
strMain = "C:\csv\"
strZipped = "C:\zipcsv\"
strZipFile = "MyZip.zip"
If Not ActiveWorkbook.Saved Then
MsgBox "Pls save " & vbNewLine & ActiveWorkbook.Name & vbNewLine & "before running this code"
Exit Sub
End If
With Application
.DisplayAlerts = False
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With
'make output diretcories if they don't exist
If Dir(strMain, vbDirectory) = vbNullString Then MkDir strMain
If Dir(strZipped, vbDirectory) = vbNullString Then MkDir strZipped
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "TOC", "Lookup"
'do nothing for these sheets
Case Else
ws.SaveAs strMain & ws.Name, xlCSV
End Select
Next
'section to run the zipping
Call NewZip(strZipped & strZipFile)
Application.Wait (Now + TimeValue("0:00:01"))
Call Zip_All_Files_in_Folder '(strZipped & strZipFile, strMain)
'end of zipping section
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = lngCalc
End With
End Sub
'Create the ZIP file if it doesn't exist
Sub NewZip(sPath As String)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
'Add the files to the Zip file
Sub Zip_All_Files_in_Folder() '(sPath As String, ByVal strMain)
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
'Shell doesn't handle the variable strings in my testing. So hardcode the same paths :(
sPath = "C:\zipcsv\MyZip.zip"
strMain = "c:\csv\"
'Copy the files to the compressed folder
oApp.Namespace(sPath).CopyHere oApp.Namespace(strMain).items
MsgBox "You find the zipfile here: " & sPath
End Sub
I have a script that will pull the html down and put it into a text or HTML file. I can then parse the text file line by line, but I'd rather either parse the website itself or parse the textstream as I get it. Is this possible using VBS (my scripting languages are limited)?
Code:
dim URL
url = "www.something.com"
set wshshell = wscript.createobject("wscript.shell")
set http = createObject("microsoft.xmlhttp")
on error resume next
http.open "GET", URL, FALSE
http.send
if err.number = 0 then
outputFile.writeline http.responsetext
else
wscript.echo "error " & err.number & ": " & err.description
end if
set wshshell = nothing
set http = nothing
patchStatusFile.close
It works fine if I write to an external HTML file. I was wondering if I HAD to write to a file or can I parse the stream first? ie:
strToLookAt = http.responsetext
do until strToLookAt.atEndOfStream
strLine = strToLookAt.readLine
if strLine = "the thing I'm looking for"
...do stuff...
end if
loop
Why did no one answer such a simple question?
here is an example of what I do.
dim up_http : up_http = "http://www.metrolyrics.com/Cornography-lyrics-Brad-Paisley.html"
dim xmlhttp : set xmlhttp = createobject("MSXML2.XMLHTTP.6.0")
xmlhttp.open "get", up_http, True
xmlhttp.send
LyricsURL = xmlhttp.responseText
'At this point we have the html from the web page in memory variable LyricsURL
No need to write to any file.
You can just process the memory variable line for line.
In this case (script not shown) I have it in a function (get_html). I then process each line of the result of the function looking for a particular strings that mark the beginning and end of the Lyrics. Then I save that result into a variable then I replace and delete characters in this variable.
Never got an answer. What I decided to do was:
1) Create a temp file where I store the text info.
2) Parse temp file.
3) Delete Temp file.
Not best idea, but in all honesty, this isn't the best script anyway. Just realized there was an "export" button on the SCCM report. I am going to see about utilizing that in a script.