vba 将 Excel 范围/工作表导出为格式化文本文件

Export Excel range/sheet to formatted text file

提问by Refracted Paladin

I have been tasked with creating a reusable process for our Finance Dept to upload our payroll to the State(WI) for reporting. I need to create something that takes a sheet or range in Excel and creates a specifically formatted text file.

我的任务是为我们的财务部门创建一个可重复使用的流程，以将我们的工资单上传到州 (WI) 进行报告。我需要创建一些在 Excel 中获取工作表或范围并创建特定格式文本文件的内容。

THE FORMAT

格式

• Column 1 - A Static Number, never changes, position 1-10
• Column 2 - A Dynamic Param filled at runtime for Quarter/Year, position 11-13
• Column 3 - SSN, no hyphens or spaces, filled from column A, position 14-22
• Column 4 - Last Name, filled from column B, Truncated at 10, Left Justify & fill with blanks, position 23-32
• Column 5 - First Name, filled from C, Truncate at 8, Left Justify & fill with blanks, position 33-40
• Column 6 - Total Gross Wages/Quarter, filled from D, strip all formatting, Right Justify Zero Fill, position 41-49
• Column 7 - A Static Code, never changes, position 50-51
• Column 8 - BLANKS, Fill with blanks, position 52-80

• 第 1 列 - 静态数字，永不改变，位置 1-10
• 第 2 列 - 在运行时为季度/年填充的动态参数，位置 11-13
• 第 3 列 - SSN，无连字符或空格，从 A 列第 14-22 位填充
• 第 4 列 - 姓氏，从 B 列填充，在 10 处截断，左对齐并用空格填充，位置 23-32
• 第 5 列 - 名字，从 C 填充，在 8 处截断，左对齐并用空格填充，位置 33-40
• 第 6 列 - 总工资/季度，从 D 填充，去除所有格式，右对齐零填充，位置 41-49
• 第 7 列 - 静态代码，永不改变，位置 50-51
• 第 8 列 - BLANKS，填空，位置 52-80

I have, I assume, 3 options:

我假设有 3 个选项：

1. VBA
2. .NET
3. SQL

1. VBA
2. 。网
3. SQL

I had explored the .NET method first but I just couldn't find decent documentation to get me going. I still like this one but I digress.

我首先探索了 .NET 方法，但我找不到合适的文档来帮助我前进。我仍然喜欢这个，但我离题了。

Next I have some VBA that will dump a Sheet to a fixed width Text. I am currently pursuing this which leads, finally, to my actual question.

接下来，我有一些 VBA 可以将工作表转储为固定宽度的文本。我目前正在追求这一点，这最终导致了我的实际问题。

How do I transform a Range of text in Excel? Do I need to coy it over to another sheet and then pass over that data with the neccesarry formatting functions the run my Dump to text routine? I currently had planned to have a function for each column but I am having trouble figuring out how to take the next step. I am fairly new at Office programming and developing in general so any insight will be greatly appreciated.

如何在 Excel 中转换文本范围？我是否需要将它复制到另一张纸上，然后使用必要的格式化功能传递该数据以运行我的 Dump to text 例程？我目前计划为每一列设置一个函数，但我无法弄清楚如何进行下一步。我在 Office 编程和开发方面相当新，所以任何见解都将不胜感激。

The SQL option would be my fall back as I have done similar exports from SQL in the past. I just prefer the other two on the, "I don't want to be responsible for running this,"principle.

SQL 选项将是我的退路，因为我过去曾从 SQL 中进行过类似的导出。我只是更喜欢其他两个关于“我不想负责运行这个”的原则。

Thanks in advance for any time given.

提前感谢您提供的任何时间。

回答by barrowc

Using VBA seems like the way to go to me. This lets you write a macro that takes care of all of the various formatting options and should, hopefully, be simple enough for your finance people to run themselves.

使用 VBA 似乎是我的方法。这使您可以编写一个处理所有各种格式选项的宏，并且应该足够简单，让您的财务人员可以自行运行。

You said you need something that takes a sheet or range in Excel. The first column never changes so we can store that in the macro, columns 3-7 come from the spreadsheet and column 8 is just blank. That leaves column 2 (the quarter/year as QYY) as an issue. If the quarter/year is specified somewhere in the workbook (e.g. stored in a cell, as a worksheet name, as part of the workbook title) then we can just read it in. Otherwise you will need to find some method for specifying the quarter/year when the macro runs (e.g. pop up a dialog box and ask the user to input it)

你说你需要一些可以在 Excel 中获取工作表或范围的东西。第一列永远不会改变，因此我们可以将其存储在宏中，第 3-7 列来自电子表格，第 8 列只是空白。这使得第 2 列（季度/年度为 QYY）成为一个问题。如果在工作簿中的某处指定了季度/年份（例如，存储在单元格中，作为工作表名称，作为工作簿标题的一部分），那么我们可以直接读入它。否则您将需要找到一些指定季度的方法/year 当宏运行时（例如弹出一个对话框并要求用户输入它）

Some simple code (we'll worry about how to call this later):

一些简单的代码（我们稍后会考虑如何调用它）：

Sub ProduceStatePayrollReportFile(rngPayrollData As Range, strCompanyNo As String, _
    strQuarterYear As String, strRecordCode As String, strOutputFile As String)

The parameters are fairly obvious: the range that holds the data, the company number for column 1, the quarter/year for column 2, the fixed code for column 7 and the file we want to output the results to

参数相当明显：保存数据的范围、第 1 列的公司编号、第 2 列的季度/年、第 7 列的固定代码以及我们要将结果输出到的文件

' Store the file handle for the output file
Dim fnOutPayrollReport As Integer
' Store each line of the output file
Dim strPayrollReportLine As String
' Use to work through each row in the range
Dim indexRow As Integer

To output to a file in VBA we need to get a file handle so we need a variable to store that in. We'll build up each line of the report in the report line string and use the row index to work through the range

要在 VBA 中输出到文件，我们需要获取文件句柄，因此我们需要一个变量来存储它。我们将在报告行字符串中构建报告的每一行，并使用行索引来处理范围

' Store the raw SSN, last name, first name and wages data
Dim strRawSSN As String
Dim strRawLastName As String
Dim strRawFirstName As String
Dim strRawWages As String
Dim currencyRawWages As Currency

' Store the corrected SSN, last name, first name and wages data
Dim strCleanSSN As String
Dim strCleanLastName As String
Dim strCleanFirstName As String
Dim strCleanWages As String

These sets of variables store the raw data from the worksheet and the cleaned data to be output to the file respectively. Naming them "raw" and "clean" makes it easier to spot errors where you accidentally output raw data instead of cleaned data. We will need to change the raw wages from a string value to a numeric value to help with the formatting

这些变量集分别存储来自工作表的原始数据和要输出到文件的清理数据。将它们命名为“raw”和“clean”可以更容易地发现您不小心输出原始数据而不是清理数据的错误。我们需要将原始工资从字符串值更改为数值以帮助格式化

' Open up the output file
fnOutPayrollReport = FreeFile()
Open strOutputFile For Output As #fnOutPayrollReport

FreeFile() gets the next available file handle and we use that to link to the file

FreeFile() 获取下一个可用的文件句柄，我们用它来链接到文件

' Work through each row in the range
For indexRow = 1 To rngPayrollData.Rows.Count
    ' Reset the output report line to be empty
    strPayrollReportLine = ""
    ' Add the company number to the report line (assumption: already correctly formatted)
    strPayrollReportLine = strPayrollReportLine & strCompanyNo
    ' Add in the quarter/year (assumption: already correctly formatted)
    strPayrollReportLine = strPayrollReportLine & strQuarterYear

In our loop to work through each row, we start by clearing out the output string and then adding in the values for columns 1 and 2

在处理每一行的循环中，我们首先清除输出字符串，然后添加第 1 列和第 2 列的值

' Get the raw SSN data, clean it and append to the report line
strRawSSN = rngPayrollData.Cells(indexRow, 1)
strCleanSSN = cleanFromRawSSN(strRawSSN)
strPayrollReportLine = strPayrollReportLine & strCleanSSN

The .Cells(indexRow, 1)part just means the left-most column of the range at the row specified by indexRow. If the ranges starts in column A (which does not have to be the case) then this just means A. We'll need to write the cleanFromRawSSNfunction ourselves later

该.Cells(indexRow, 1)部分仅表示 indexRow 指定的行中范围的最左侧列。如果范围从 A 列开始（不一定是这种情况），那么这仅表示 A。我们稍后需要自己编写cleanFromRawSSN函数

' Get the raw last and first names, clean them and append them
strRawLastName = rngPayrollData.Cells(indexRow, 2)
strCleanLastName = Format(Left$(strRawLastName, 10), "!@@@@@@@@@@")
strPayrollReportLine = strPayrollReportLine & strCleanLastName

strRawFirstName = rngPayrollData.Cells(indexRow, 3)
strCleanFirstName = Format(Left$(strRawFirstName, 8), "!@@@@@@@@")
strPayrollReportLine = strPayrollReportLine & strCleanFirstName

Left$(string, length)truncates the string to the given length. The format picture !@@@@@@@@@@formats a string as exactly ten characters long, left justified (the ! signifies left justify) and padded with spaces

Left$(string, length)将字符串截断为给定的长度。格式图片!@@@@@@@@@@将字符串格式化为正好十个字符长，左对齐（! 表示左对齐）并用空格填充

' Read in the wages data, convert to numeric data, lose the decimal, clean it and append it
strRawWages = rngPayrollData.Cells(indexRow, 4)
currencyRawWages = CCur(strRawWages)
currencyRawWages = currencyRawWages * 100
strCleanWages = Format(currencyRawWages, "000000000")
strPayrollReportLine = strPayrollReportLine & strCleanWages

We convert it to currency so that we can multiply by 100 to move the cents value to the left of the decimal point. This makes it much easier to use Formatto generate the correct value. This will not produce correct output for wages >= $10 million but that's a limitation of the file format used for reporting. The 0in the format picture pads with 0s surprisingly enough

我们将其转换为货币，以便乘以 100 将美分值移动到小数点左侧。这使得使用Format生成正确的值变得更加容易。对于工资 >= 1000 万美元，这不会产生正确的输出，但这是用于报告的文件格式的限制。在0以0令人惊讶的是在格式图片垫

' Append the fixed code for column 7 and the spaces for column 8
strPayrollReportLine = strPayrollReportLine & strRecordCode
strPayrollReportLine = strPayrollReportLine & CStr(String(29, " "))

' Output the line to the file
Print #fnOutPayrollReport, strPayrollReportLine

The String(number, char)function produces a Variant with a sequence of numberof the specified char. CStrturns the Variant into a string. The Print #statement outputs to the file without any additional formatting

该String(number, char)函数生成具有number指定的序列的 Variant char。CStr将 Variant 转换为字符串。该Print #语句输出到文件中，没有任何额外的格式

Next indexRow

' Close the file
Close #fnOutPayrollReport

End Sub

Loop round to the next row in the range and repeat. When we have processed all of the rows, close the file and end the macro

循环到范围内的下一行并重复。当我们处理完所有行后，关闭文件并结束宏

We still need two things: a cleanFromRawSSN function and a way to call the macro with the relevant data.

我们仍然需要两件事：cleanFromRawSSN 函数和使用相关数据调用宏的方法。

Function cleanFromRawSSN(strRawSSN As String) As String

' Used to index the raw SSN so we can process it one character at a time
Dim indexRawChar As Integer

' Set the return string to be empty
cleanFromRawSSN = ""

' Loop through the raw data and extract the correct characters
For indexRawChar = 1 To Len(strRawSSN)
    ' Check for hyphen
    If (Mid$(strRawSSN, indexRawChar, 1) = "-") Then
        ' do nothing
    ' Check for space
    ElseIf (Mid$(strRawSSN, indexRawChar, 1) = " ") Then
        ' do nothing
    Else
        ' Output character
        cleanFromRawSSN = cleanFromRawSSN & Mid$(strRawSSN, indexRawChar, 1)
    End If
Next indexRawChar

' Check for correct length and return empty string if incorrect
If (Len(cleanFromRawSSN) <> 9) Then
    cleanFromRawSSN = ""
End If

End Function

Lenreturns the length of a string and Mid$(string, start, length)returns lengthcharacters from stringbeginning at start. This function could be improved as it doesn't currently check for non-numeric data

Len返回字符串的长度并Mid$(string, start, length)返回length从string开始的字符start。此功能可以改进，因为它目前不检查非数字数据

To call the macro:

调用宏：

Sub CallPayrollReport()

ProduceStatePayrollReportFile Application.Selection, "1234560007", "109", "01", "C:\payroll109.txt"

End Sub

This is the simplest way to call it. The Range is whatever the user has selected on the active worksheet in the active workbook and the other values are hard-coded. The user should select the range they want to output to the file then go Tools > Macro > Run and choose CallPayrollReport. For this to work, the macro would either need to be part of the workbook containg the data or in a different workbook which had been loaded before the user calls the macro.

这是最简单的调用方式。范围是用户在活动工作簿中的活动工作表上选择的任何内容，其他值是硬编码的。用户应该选择他们想要输出到文件的范围，然后去工具 > 宏 > 运行并选择CallPayrollReport. 为此，宏要么需要成为包含数据的工作簿的一部分，要么位于用户调用宏之前已加载的不同工作簿中。

Someone would need to change the hard-coded value of the quarter/year before each quarter's report was generated. As stated earlier, if the quarter/year is already stored in the workbook somewhere then it's better to read that in rather than hard-coding it

在生成每个季度的报告之前，有人需要更改季度/年度的硬编码值。如前所述，如果季度/年度已经存储在工作簿中的某个地方，那么最好阅读它而不是硬编码它

Hope that makes sense and is of some use

希望这是有道理的，有一定的用处

回答by Refracted Paladin

Wow!

哇！

I have to say, I am blown away. You so far exceeded my expectations for an answer that I feel guilty that I can ONLY up vote you once and mark as excepted. I had HOPED for so guidance towards which path was best and some formatting. Well Happy Birthday to me!

我不得不说，我被吹走了。到目前为止，您的回答超出了我的期望，我感到内疚，因为我只能给您投票一次并将其标记为例外。我希望得到关于哪条路径最好和一些格式的指导。好吧，祝我生日快乐！

The Format() and FreeFile() were especially new useful info. Also, just to show that I was trying, my attempt is below. I was quite close as I was just working out the formatting details but I believe I shall rework it with your input as it seems the more elegant approach.

Format() 和 FreeFile() 是特别有用的新信息。另外，为了表明我正在尝试，我的尝试如下。我非常接近，因为我只是在制定格式细节，但我相信我会根据你的输入重新修改它，因为它似乎是更优雅的方法。

As a final note. I found this place thru Jeff Atwood's blog and I was truly excited by the idea. As a new, inexperienced developer in a solo shop I had always wished there was someplace I could turn for mentorship. Books and articles get you to a point but nothing equals the advice of someone who's done it or been there. So far StackOverflow has delivered.

作为最后的说明。我通过 Jeff Atwood 的博客找到了这个地方，我对这个想法感到非常兴奋。作为一个新的、没有经验的开发人员，我一直希望有一个地方可以寻求指导。书籍和文章让你达到一个目的，但没有什么比做过或去过那里的人的建议更重要了。到目前为止，StackOverflow 已经交付。

For reference, I posted this exact same question on another very popular Code Forum and have yet to receive a single response in any way.

作为参考，我在另一个非常受欢迎的代码论坛上发布了这个完全相同的问题，但尚未收到任何回复。

Now for my attempt:

现在我的尝试：

The Module Code

模块代码

    Sub StateANSIIExport()
    Dim Sizes As Variant
    Dim arr As Variant
    Dim aRow As Long, aCol As Long
    Dim rowLimit As Integer, colLimit As Integer
    Dim SpacesPerCell As Integer
    Dim fso As Object
    Dim ts As Object
    Dim TheLine As String
    Dim TestStr As String

    arr = ActiveSheet.UsedRange
    rowLimit = UBound(arr, 1)
    'colLimit = UBound(arr, 2)
    colLimit = 8
    SpacesPerCell = 20      'Set export text "column" width here

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.CreateTextFile(GetDesktopPath() & "EXCELTEXT.txt", True)

    ' Loop thru the rows
    For aRow = 1 To rowLimit
        TheLine = Space(colLimit * SpacesPerCell)     ' your fixed-width output
        ' Loop thru the columns
        For aCol = 1 To colLimit
            Select Case aCol
                Case 1  ' Employer UI Account #
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "6979430002"
                Case 2  ' Reporting Period (QYY)
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "109"
                Case 3  ' SSN
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "A")
                Case 4  ' Last Name
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "B")
                Case 5  ' First Name
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "C")
                Case 6  ' Employee Quartly Gross Wages
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "D")
                Case 7   ' Record Code
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "01"
                Case 8  ' BLANK
                    Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "                             "
            End Select
        Next aCol
        ' Write the line to the file
        ts.WriteLine TheLine
    Next aRow

    ts.Close

    Set ts = Nothing
    Set fso = Nothing

    MsgBox "Done"
End Sub

    Sub MacroToRunTwo()
    Dim S As String
    S = "Hello World From Two:" & vbCrLf & _
        "This Add-In File Name: " & ThisWorkbook.FullName
    MsgBox S
End Sub

Function GetDesktopPath() As String
'Return the current user's desktop path
GetDesktopPath = "C:\Users\patrick\Desktop\"
'GetDesktopPath = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop\"
End Function

And The WorkBook Code:

和工作簿代码：

    Private Const C_TAG = "Refracted Solutions" ' C_TAG should be a string unique to this add-in.
Private Const C_TOOLS_MENU_ID As Long = 30007&

Private Sub Workbook_Open()
'''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_Open
' Create a submenu on the Tools menu. The
' submenu has two controls on it.
'''''''''''''''''''''''''''''''''''''''''''''''
Dim ToolsMenu As Office.CommandBarControl
Dim ToolsMenuItem As Office.CommandBarControl
Dim ToolsMenuControl As Office.CommandBarControl

'''''''''''''''''''''''''''''''''''''''''''''''
' First delete any of our controls that
' may not have been properly deleted previously.
'''''''''''''''''''''''''''''''''''''''''''''''
DeleteControls

''''''''''''''''''''''''''''''''''''''''''''''
' Get a reference to the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
Set ToolsMenu = Application.CommandBars.FindControl(ID:=C_TOOLS_MENU_ID)
If ToolsMenu Is Nothing Then
    MsgBox "Unable to access Tools menu.", vbOKOnly
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''
' Create a item on the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
Set ToolsMenuItem = ToolsMenu.Controls.Add(Type:=msoControlPopup, temporary:=True)
If ToolsMenuItem Is Nothing Then
    MsgBox "Unable to add item to the Tools menu.", vbOKOnly
    Exit Sub
End If

With ToolsMenuItem
    .Caption = "&WWCares"
    .BeginGroup = True
    .Tag = C_TAG
End With

''''''''''''''''''''''''''''''''''''''''''''''
' Create the first control on the new item
' in the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
If ToolsMenuControl Is Nothing Then
    MsgBox "Unable to add item to Tools menu item.", vbOKOnly
    Exit Sub
End If

With ToolsMenuControl
    ''''''''''''''''''''''''''''''''''''
    ' Set the display caption and the
    ' procedure to run when clicked.
    ''''''''''''''''''''''''''''''''''''
    .Caption = "State ANSII E&xport"
    .OnAction = "'" & ThisWorkbook.Name & "'!StateANSIIExport"
    .Tag = C_TAG
End With

''''''''''''''''''''''''''''''''''''''''''''''
' Create the second control on the new item
' in the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
'Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
'If ToolsMenuControl Is Nothing Then
'    MsgBox "Unable to add item to Tools menu item.", vbOKOnly
'    Exit Sub
'End If

'With ToolsMenuControl
    ''''''''''''''''''''''''''''''''''''
    ' Set the display caption and the
    ' procedure to run when clicked.
    ''''''''''''''''''''''''''''''''''''
'    .Caption = "Click Me &Two"
'    .OnAction = "'" & ThisWorkbook.Name & "'!MacroToRunTwo"
'    .Tag = C_TAG
'End With

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_BeforeClose
' Before closing the add-in, clean up our controls.
''''''''''''''''''''''''''''''''''''''''''''''''''''
    DeleteControls
End Sub


Private Sub DeleteControls()
''''''''''''''''''''''''''''''''''''
' Delete controls whose Tag is
' equal to C_TAG.
''''''''''''''''''''''''''''''''''''
Dim Ctrl As Office.CommandBarControl

On Error Resume Next
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)

Do Until Ctrl Is Nothing
    Ctrl.Delete
    Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
Loop

End Sub

回答by dkretz

Thinking about this strictly from the viewpoint of what's easiest for you, and if you are comfortable with SQL, in the context of Access, you could use Access to attach to the spreadsheet as an external datasource. It would look like a table in Access, and work from there.

严格从对您最简单的角度考虑，如果您对 SQL 感到满意，在 Access 上下文中，您可以使用 Access 作为外部数据源附加到电子表格。它看起来像 Access 中的一个表，并从那里开始工作。

回答by Andy Mikula

Depending on the format of your document, I'd probably recommend exporting to .csv and working with that. If all you need is the numbers, this would be the easiest way to go.

根据您的文档格式，我可能会建议导出到 .csv 并使用它。如果您只需要数字，这将是最简单的方法。