VBA使用macros将22个pipe道（|）添加到文本文件
我希望你可以帮助我有一段代码，它是从两个Excel表中获取信息，并将其放入两个文本文档中供数据库使用。
代码我已经正常工作，但22列已被添加到数据库中的文本文件注定要被消耗，所以我需要把22pipe道（|）公司之前在记事本文件
第一张照片是Excel表格，工作人员可以input数据 
第二张图显示的是从“会议closures模板”中sorting数据的Excel工作表，macros选取要转换为文本的数据。 这个sorting表被称为“Template-EFPIA-iTOV”灰色的列是macros观图片
在下面的图片中，您可以看到“公司ID”是“Template-EFPIA-iTOV”中的最后一列 
以下是表格“Template-EFPIA-iTOV”在文本中的表示方式 
这是公司文件中的公司ID 
因为目标数据库现在已经有了额外的22列之前的公司ID我需要我的macros放22个pipe道（|）公司ID之前的文本文档。
Excel工作表“EFPIA客户模板”也可以转换为文本，但是这样很好，不需要修改。
我的代码如下。 像往常一样，任何帮助，不胜感激。
macros前端的图片
码
'Variables for Deduplication Dim WB_Cust As Workbook 'File Variables Dim DTOV_Directory As String Dim DTOV_File As String Dim ITOV_Directory As String Dim ITOV_file As String Const DELIMITER As String = "|" ' Variables for writing text into file Dim WriteObject As Object Dim OUTFilename As String Dim MyWkBook As Workbook Dim MyWkSheet As Worksheet Dim OutputFile As String ' Output flat file name Dim SysCode As String ' Variable for text string of system code to be filled into information system code column Dim strFilenameOut As String ' Variable for name of file being processed. It is used for SysCode and OutputFile determination. Dim CustAddressSave As Range 'Processing of one file. This procedure is called when only one of file types are selected Public Sub Process_template(Directory As String, File As String, FileFlag As String) Application.ScreenUpdating = False 'Turns off switching of windows If FileFlag = "D" Then 'Variables setup for DTOV DTOV_Directory = Directory DTOV_File = File ElseIf FileFlag = "I" Then 'Variables setup for ITOV ITOV_Directory = Directory ITOV_file = File Else MsgBox "Unhandled Exception - Unknown files sent" Exit Sub End If Call Process(1, FileFlag) Application.ScreenUpdating = True 'Turns On switching of windows End Sub 'Processing of two file. This procedure is called when both file types are to be processed Public Sub Process_Templates(DTOV_Dir As String, DTOV_Fil As String, ITOV_Dir As String, ITOV_Fil As String) Application.ScreenUpdating = False 'Turns off switching of windows DTOV_Directory = DTOV_Dir DTOV_File = DTOV_Fil ITOV_Directory = ITOV_Dir ITOV_file = ITOV_Fil Call Process(2, "B") Application.ScreenUpdating = True 'Turns on switching of windows End Sub ' ***************************************************************************** ' Management of File to write in UT8 format ' ***************************************************************************** ' This function open the file indicated to be able to write inside Private Sub OUTFILE_OPEN(filename As String) Set WriteObject = CreateObject("ADODB.Stream") WriteObject.Type = 2 'Specify stream type - we want To save text/string data. WriteObject.Charset = "utf-8" 'Specify charset For the source text data. WriteObject.Open 'Open the stream And write binary data To the object OUTFilename = filename End Sub ' This function closes the file Private Sub OUTFILE_CLOSE() WriteObject.SaveToFile OUTFilename, 2 WriteObject.Close ' Close the file End Sub ' Write a string in the outfile Private Sub OUTFILE_WRITELINE(txt As String) WriteObject.WriteText txt & Chr(13) & Chr(10) txt = "" End Sub ' subprocedure to read TOV data into stream and call procedure to generate file Public Sub generate_tov(i_Sheet_To_Process As String, _ i_OffsetShift As Integer) Dim sOut As String ' text to be written into file 'Set OutputFile = "sarin" Sheets(i_Sheet_To_Process).Select Range("C2").Select 'Parsing of system code from filename strFilenameOut = ActiveWorkbook.Name 'example - initial file name: EFPIA_DTOV-BE-MTOV-201503271324.xlsx SysCode = Left(strFilenameOut, InStrRev(strFilenameOut, "-") - 1) 'example - after LEFT cut EFPIA_ITOV-BE-MTOV SysCode = Right(SysCode, Len(SysCode) - InStrRev(SysCode, "-")) 'example - after RIGHT cut MTOV Do Until (IsError(ActiveCell.Offset(0, 1).Value) = True) If ActiveCell.Offset(0, 1).Value = "" Then 'end-of-file reached, hence exist the do loop Exit Do End If ActiveCell.Value = SysCode ActiveCell.Offset(0, i_OffsetShift).Value = Application.WorksheetFunction.VLookup(Sheets("Template - EFPIA Customer").Cells(ActiveCell.Row, 3).Value, Sheets("Appendix").Range("N1:O103"), 2, "FALSE") & "_" & ActiveCell.Offset(0, i_OffsetShift).Value ActiveCell.Offset(1, 0).Select Loop OutputFile = Left(strFilenameOut, InStrRev(strFilenameOut, ".") - 1) & ".txt" If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then MsgBox ("incorrect data in the TOV source file. Please correct and re-run the macro") Exit Sub Else Call generate_file End If End Sub ' procedures to write stream data into file for both TOV and customer Public Sub generate_file() Dim X As Integer Dim Y As Long Dim FieldValue As String Dim NBCol As Integer Dim sOut As String ' text to be written into file OUTFILE_OPEN (OutputFile) 'Open (setup) the output file 'Open OutputFile For Output As #1 'Prepares new file for output Set MyWkBook = ActiveWorkbook Set MyWkSheet = ActiveSheet NBCol = 0 Do While (Trim(MyWkSheet.Cells(1, NBCol + 1)) <> "") NBCol = NBCol + 1 Loop ' Scroll all rows Y = 1 Do While (Trim(MyWkSheet.Cells(Y, 4)) <> "") sOut = "" For X = 1 To NBCol ' here, if required, insert a convertion type function FieldValue = Trim(MyWkSheet.Cells(Y, X)) FieldValue = Replace(FieldValue, "|", "/") 'Replaces pipes from input file to slashes to avoid mismatches during ETL If FieldValue = "0" Then FieldValue = "" 'Replaces "only zeroes" - might need redoing only for amount columns If InStr(MyWkSheet.Cells(1, X), "Amount") > 0 Then FieldValue = Replace(FieldValue, ",", ".") ' add into the string If X = NBCol Then sOut = sOut & FieldValue Else sOut = sOut & FieldValue & DELIMITER End If Next X Y = Y + 1 OUTFILE_WRITELINE sOut Loop OUTFILE_CLOSE End Sub ' read the customer data into stream Public Sub read_customer(i_Sheet_To_Process As String, _ i_range As String) Dim CCST As Workbook ' Variable to keep reference for template Workbook that is being used for copy-paste of Customer data into virtuall Workbook Sheets(i_Sheet_To_Process).Select ActiveSheet.UsedRange.Copy Set CCST = ActiveWorkbook WB_Cust.Activate If i_range = "" Then Sheets("Sheet1").Range(CustAddressSave.Address).PasteSpecial xlPasteValues Range(CustAddressSave.Address).Select ActiveCell.Offset(0, 2).Select Rows(CustAddressSave.Row).EntireRow.Delete Else Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues Range("C2").Select End If 'Call LookingUp(CCST) Do Until (IsError(ActiveCell.Offset(0, 1).Value) = True) If ActiveCell.Offset(0, 1).Value = "" Then 'end-of-file reached, hence exist the do loop Exit Do End If ActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, 0).Value, CCST.Sheets("Appendix").Range("N1:O103"), 2, "FALSE") & "_" & ActiveCell.Offset(0, 1).Value ActiveCell.Value = SysCode ActiveCell.Offset(1, 0).Select Loop If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then MsgBox ("incorrect data in the source file. Please correct and re-run the macro") Exit Sub Else Set CustAddressSave = ActiveCell.Offset(0, -2) 'Saves position where 2nd Cust data sheet will be copied OutputFile = Left(Mid(strFilenameOut, 1, (InStr(strFilenameOut, "_"))) & "CUST" & Mid(strFilenameOut, (InStr(strFilenameOut, "-"))), InStrRev(strFilenameOut, ".") - 1) & ".txt" End If End Sub 'Main Procedure of the module that processes the files Private Sub Process(Loops As Integer, FileFlag As String) 'Loops - number of files (1 or 2), FileFlag - which file is to be processed (I - ITOV, D - DTOV, B - Both) Set WB_Cust = Workbooks.Add ' This virtual workbook is created only for duration of the processing. It is used to copy paste CUSTOMER data form one or both templates. If FileFlag = "D" Or FileFlag = "B" Then ' process DTOV first always Call Open_DTOV '---------------------------------------------------------- Call generate_tov("Template - Transfer of Value", 3) ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If '---------------------------------------------------------- Call read_customer("Template - EFPIA Customer", "A") ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If End If If FileFlag = "I" Or FileFlag = "B" Then Call Open_ITOV '---------------------------------------------------------- Call generate_tov("Template - EFPIA iToV", 17) ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If '---------------------------------------------------------- If FileFlag = "B" Then Call read_customer("Template - EFPIA Customer", "") Else Call read_customer("Template - EFPIA Customer", "A") End If ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If End If Call Deduplicate Call generate_file ' generate single customer file MsgBox "Export Process is completed" HandleException: ' Closes the virtual workbook used for consolidation and deduplication of customers WB_Cust.Saved = True WB_Cust.Close ActiveWorkbook.Saved = True 'Closes Template ActiveWorkbook.Close (False) If Loops = 2 Then 'Closes second Template if two files are being processed ActiveWorkbook.Saved = True ActiveWorkbook.Close (False) End If Application.ScreenUpdating = True 'Turns back on switching to exported excel file once it gets opened Exit Sub End Sub 'Unused Procedure to reduce Customer data processing code. Does not work now. Private Sub LookingUp(CCST As Workbook) Do Until (ActiveCell.Offset(0, 1).Value = "") ActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, 0).Value, CCST.Sheets("Appendix").Range("N1:O103"), 2, "FALSE") & "_" & ActiveCell.Offset(0, 1).Value ActiveCell.Value = SysCode ActiveCell.Offset(1, 0).Select Loop End Sub 'Open DTOV Template Private Sub Open_DTOV() Workbooks.Open (DTOV_Directory + DTOV_File) End Sub 'Open ITOV Template Private Sub Open_ITOV() Workbooks.Open (ITOV_Directory + ITOV_file) End Sub 'Deduplicating Customer data based on Source_Party_Identifier, which already contains source code prefix Private Sub Deduplicate() ActiveSheet.UsedRange.RemoveDuplicates Columns:=4, Header:=xlYeas End Sub 由于您的代码设置为使用generate_file这一部分来检测列的数量：
Do While (Trim(MyWkSheet.Cells(1, NBCol + 1)) <> "") NBCol = NBCol + 1 Loop
…然后将所有行dynamic保存到pipe道分隔的文本文件中，强烈build议将新列添加到工作表中，即使它们将变为空白。
但是，如果您想通过评估来完成工作，则可以始终为每个输出行添加22个pipe道。 用OUTFILE_WRITELINE sOutreplaceOUTFILE_WRITELINE sOut OUTFILE_WRITELINE "
|" & sOut OUTFILE_WRITELINE "
|" & sOut 。
如果你决定使用这个丑陋的黑客，请确保你非常仔细地对它进行评论，这样当代码不可避免地再次发生变化时，你和代码的任何其他维护者都可以find并修复它。