How to write a data to a text file (VBA)

[Rhodie72]

I need to write data to a text file as a data steam
I have written preliminary code to capute data in a spreadsheet but the ultimate goal is to write the data direct to a text file without using a spreadsheet.

currently the spreadsheet is just to verify that the data is being captured correctly but it needs to be written to an array and then output as a text file with a line that is the command for an AutoCAD script.
The source data

SOP1

184320.468

398332.116

77,135

SOP2

184324.959

398335.356

77,135

SOP3

184369.416

398248.340

77,135

SOP4

184317.345

398251.648

77,135

SOP1.5

184310.358

398252.072

77,135

SOP1.6

184311.268

398267.045

77,135

SOP1.7

184318.255

398266.620

77,135

SOP2.1

184356.47

398057.478

77,135

SOP2.2

184304.218

398060.209

77,135

SOP2.3

184306.115

398096.166

77,135

SOP2.4

184308.803

398099.982

77,135

SOP2.5

184309.881

398117.917

77,135

SOP2.6

184307.445

398121.375

77,135

SOP3.1

184357.481

398102.259

77,135

SOP3.2

184357.237

398098.266

77,135

SOP3.3

184311.084

398104.783

77,135

SOP3.4

184310.867

398100.789

77,135

So far it produces this table

SOP1	184320.468,398332.116
SOP2	184324.959,398335.356
SOP3	184369.416,398248.34
SOP4	184317.345,398251.648
SOP1.5	184310.358,398252.072
SOP1.6	184311.268,398267.045
SOP1.7	184318.255,398266.62
SOP2.1	184356.47,398057.478
SOP2.2	184304.218,398060.209
SOP2.3	184306.115,398096.166
SOP2.4	184308.803,398099.982
SOP2.5	184309.881,398117.917
SOP2.6	184307.445,398121.375
SOP3.1	184357.481,398102.259
SOP3.2	184357.237,398098.266
SOP3.3	184311.084,398104.783
SOP3.4	184310.867,398100.789

The data ouput format required for "MyFile.scr"

PLINE


184320.468,398332.116
184324.959,398335.356
184369.416,398248.34
184317.345,398251.648
184310.358,398252.072
184311.268,398267.045
184318.255,398266.62
184356.47,398057.478
184304.218,398060.209
184306.115,398096.166
184308.803,398099.982
184309.881,398117.917
184307.445,398121.375
184357.481,398102.259
184357.237,398098.266
184311.084,398104.783
184310.867,398100.789

The code so far..

Sub Adjust_ColWidth()
'
' Adjust_ColWidth Macro
' Autofit column width
'

'
    Columns("A:A").EntireColumn.AutoFit
End Sub
Public Sub Delete_Blanks()
'
' Delete_Blanks Macro
' Deletes blanks in selection
'

'
    With Selection
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    'Application.CutCopyMode = False
End Sub
Sub Reorder_Data()
'
' Reorder_Data Macro
' Reorders data secions to correct places
'
Dim N
'
    Run "Adjust_ColWidth"
    Run "Delete_Blanks"
    Range("A1").Select
    Run "Arrange_SOP_Data"
    With Selection
        .Copy
        N = .Count - 1
        MsgBox "There are " & N & " lines of data to export", vbInformation, "Data Check"
    End With
    Application.CutCopyMode = False
'   Export dataset to script file for AutoCAD
End Sub
Public Sub Delete_cells_up()
'
' Delete_cells_up Macro
' Deletes empty cells
'

'
    With Selection
        .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        .End(xlUp).Select
    End With
End Sub

Public Sub Arrange_SOP_Data()
    Dim SOP_Data As Variant, X As Variant, Y As Variant

    Do Until Left(ActiveCell.Offset(1, 0).Value, 3) = ""
        If Left(ActiveCell.Value, 3) = "SOP" Then
            X = ActiveCell.Offset(1, 0).Text: Y = ActiveCell.Offset(2, 0).Text
            SOP_Data = Array(X, ",", Y)
            With ActiveCell
                .Offset(0, 1).Value = SOP_Data(0) & SOP_Data(1) & SOP_Data(2)
                Range(.Offset(1, 0), .Offset(3, 0)).EntireRow.Delete
                .Offset(1, 0).Select
            End With
        Else
            Stop
            
            Do Until Left(ActiveCell.Value, 3) = "SOP"
                ActiveCell.Offset(1, 0).Select
            Loop
            If Left(ActiveCell.Offset(1, 0).Value, 3) <> "SOP" Then
                X = ActiveCell.Offset(1, 0).Value: Y = ActiveCell.Offset(2, 0).Value
                SOP_Data = Array(X, ",", Y)
            End If
        End If
    Loop
    
    With Range("B1", ActiveCell.Offset(-1, 1))
        .Select
        Y = .Count
        .EntireColumn.AutoFit
        MsgBox Y
    End With
End Sub

My aim is literally to capture the reordered data of co-ordinates add the command to the first output, add a new line, append rthe file with each pair of cordinates then close the file.
Anybody up for this task to help out? The person who does this will discover what impact they have had on a major construction project, so there's a bragging right attached.

 

[Rhodie72]

Guys, thank you. You've been amazing and the code is great. The picture below is what you have helped me design the safety plan for in its construction. In addition you have also allowed me to compare data from 3D models against printed plan data and pick out the errors.

Do not ever think that VBA has little relevance to the world. It has impacts that go far beyond the office computers into the real world for built environments.

 

[rlv01]

Do not ever think that VBA has little relevance to the world. It has impacts that go far beyond the office computers into the real world for built environments.

I am well aware

 

[Rhodie72]

after a complete re-write I came up with this which works much better for the varying data pastes from Google translate

Sub Find_Blanks()
'
' Find_Blanks Macro
'
On Error Resume Next
'
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("A1", Cells(1)).End(xlUp).Select
'    Range(Selection, Cells(1)).Select
End Sub

Sub Verify_Content()
    Dim Num, Letter
    Select Case IsNumeric(ActiveCell.Offset(3, 0).Value) 'Determines format of pasted content
        Case True
            Do Until IsEmpty(ActiveCell.Value) = True
                Select Case IsNumeric(ActiveCell.Value)
                    Case False
                        MsgBox ActiveCell.Value
                    Case True
                        MsgBox ActiveCell.Value
                        With ActiveCell
                            .Offset(-1, 0).Value = WorksheetFunction.Concat(.Offset(-1, 0).Value, " ", .Offset(-1, 1).Value)
                            .Offset(-1, 1).Value = ActiveCell.Value
                            .Offset(-1, 2).Value = .Offset(1, 0).Value
                                Do Until ActiveCell.Value = Empty
                            Do While IsNumeric(ActiveCell.Value) <> False
                                    ActiveCell.EntireRow.Delete
                                Loop
                            Loop
                        End With
                End Select
                ActiveCell.Offset(1, 0).Select
            Loop
        Case 5
            MsgBox "Undetermined case in Case 5", vbCritical
            
    End Select
    
End Sub

And this is where I am having trouble... I cannot use FileSystemObject for some unknown reason. It just omes up with an error
This code doesn't work on my system:

Sub FSOCreateAndWriteToTextFile()
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FileToCreate = FSO.CreateTextFile("C:\Test\TestFile.txt")

    FileToCreate.Write "test line"
    FileToCreate.Close

End Sub

I am still left with this lot to work out and I have 2 days of work to complete it.

Sub Script2Acad()
' 2 columnsneed to be extrracted to a text file with .scr suffix to work.
' The first 2 lines of the script file must be 
' "PLINE" & chr(10)
' Data copied from the worksheet stored in an ascii file with "," between co-ordinates
' Must open a "save as..." dialog box to choose the loaction of the saved script file with .scr suffix

End Sub

Any ideas?

 

[rlv01]

Any ideas?

Didn't I already post code to do this a couple of weeks ago?

 

[rlv01]

I cannot use FileSystemObject for some unknown reason. It just omes up with an error

Not much anyone can do if you do not share details about the error. For any error (compile error or runtime error) it is important to report 3 things:
1. Error number
2. Error message
3. Line of code that generates the error. (typically, you would press the 'Debug' button on the error dialog to find the line)

 

[Rhodie72]

Didn't I already post code to do this a couple of weeks ago?

You did but it failed with an error

Dim FSO As FileSystemObject

 

[rlv01]

You did but it failed with an error

Dim FSO As FileSystemObject

Very curious since the code I posted did not contain the statement Dim FSO As FileSystemObject or any other reference to the FileSystemObject, and you posted at the time that it worked.

However, that error is likely because you don't have the proper library reference ticked (Microsoft Scripting Runtime).

 

[Rhodie72]

Very curious since the code I posted did not contain the statement Dim FSO As FileSystemObject or any other reference to the FileSystemObject, and you posted at the time that it worked.

However, that error is likely because you don't have the proper library reference ticked (Microsoft Scripting Runtime).

View attachment 114003

Tht was odd. You were right that scripting rtl wasn't installed so I'll give it a go now. tyvm