If you use a Siemens Health Care system, you have probably heard of OLIE Scripting. OLIE (Online Interface Express) is a tool that manipulates the terminal session of a product. So you can go through and automate the changes or add data to a system, through the User Interface. The data one inputs is normally stored in a .txt or .prn file.
So today there was some data in an excel spreadsheet, that someone wanted to get into a .prn file. A prn file is a formatted text, space delimited file layout. The only problem is that excel only saves 240 characters. If you need 250, you are out of luck.
However, Microsoft has noted this problem, and this KNB is a great aid. The code works great for a solution.
However, I tweaked the code a little today, so that the popup wouldn't occur, and people could just select via the columns or page. Remember, first select the entire workbook, make the style Courier, and then Autofit all columns, then run the macro.
That code is below. Just remember, the macro by default goes into a workbook. If you want it on your desktop permanently, unhide the personal.xls and add the macro there. When you are finished, rename the file externsion on your .txt file to .prn.
Sub ExportText()
Dim delimiter As String
Dim quotes As Integer
Dim Returned As String
delimiter = " "
' Call the WriteFile function passing the delimiter and quotes options.
Returned = WriteFile(delimiter)
' Print a message box indicating if the process was completed.
Select Case Returned
Case "Canceled"
MsgBox "The export operation was canceled."
Case "Exported"
MsgBox "The information was exported."
End Select
End Sub
'-------------------------------------------------------------------
Function WriteFile(delimiter As String) As String
' Dimension variables to be used in this function.
Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Long
Dim ColNum As Long
Dim FNum As Long
Dim TotalRows As Double
Dim TotalCols As Double
' Show Save As dialog box with the .TXT file name as the default.
' Test to see what kind of system this macro is being run on.
If Left(Application.OperatingSystem, 3) = "Win" Then
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")
Else
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"TEXT", , "Text Delimited Exporter")
End If
' Check to see if Cancel was clicked.
If SaveFileName = False Then
WriteFile = "Canceled"
Exit Function
End If
' Obtain the next free file number.
FNum = FreeFile()
' Open the selected file name for data output.
Open SaveFileName For Output As #FNum
' Store the total number of rows and columns to variables.
TotalRows = Selection.Rows.Count
TotalCols = Selection.Columns.Count
' Loop through every cell, from left to right and top to bottom.
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
' Store the current cells contents to a variable.
Select Case .HorizontalAlignment
Case xlRight
CellText = Space(ColWidth - Len(.Text)) & .Text
Case xlCenter
CellText = Space((ColWidth - Len(.Text)) / 2) & .Text & _
Space((ColWidth - Len(.Text)) / 2)
Case Else
CellText = .Text & Space(ColWidth - Len(.Text))
End Select
End With
CellText = CellText & delimiter
Print #FNum, CellText;
' Update the status bar with the progress.
Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
+ ColNum) / (TotalRows * TotalCols), "0%") & " Completed."
' Loop to the next column.
Next ColNum
' Add a linefeed character at the end of each row.
If RowNum <> TotalRows Then Print #FNum, ""
' Loop to the next row.
Next RowNum
' Close the .prn file.
Close #FNum
' Reset the status bar.
Application.StatusBar = False
WriteFile = "Exported"
End Function
Subscribe and Share!
Did you enjoy this article? Your feedback is very important! I'd like to invite you to keep up to date with the latest posts from Anticlue. We offer several venues. If you have some questions, help can be found here.- Become a Facebook Fan
- Subscribe to Anticlue
- Follow me on Twitter
- Add to Technorati Favorites
- Digg this post



