VBA使用宏添加22個管道（|）到文本文件

Question

我希望你能幫忙我有一段代碼，它是做什麼的，它需要來自兩個Excel工作表的信息，並將其放入兩個文本文檔中以便在數據庫。

我的代碼工作正常，但22列已在文本文件註定要被消耗掉，所以我需要把22管數據庫添加（|）公司ID之前在記事本文件

第一PIC是Excel工作表的工作人員可以輸入數據

第二PIC顯示excel表，其中數據從「會議收出模板」和宏拾取用於轉化成文本數據排序。這個排序表被稱爲「模板的EFPIA-iTOV」灰色列是什麼宏觀圖片了

在下面的圖可以看到該公司ID是「模板的EFPIA最後一列-iTOV

下面是如何表 '模板，EFPIA-iTOV' 文本

這裏表示的是公司的ID在文本文件中

因爲目標數據庫現在已經在公司ID之前得到了額外的22列，所以我需要我的宏在文本文檔中的公司ID之前放置22個管道（|）。

Excel工作表'模板EFPIA客戶'也converetd文本，但這是好的，不需要修改。

我的代碼如下。與往常一樣，任何幫助都不勝感激。

產品圖宏前的結束

CODE

'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 

Answer 1

由於您的代碼被設置爲檢測使用的generate_file本節中的列數：

Do While (Trim(MyWkSheet.Cells(1, NBCol + 1)) <> "") 
    NBCol = NBCol + 1 
Loop 

...然後動態保存所有行對於管道分隔的文本文件，我強烈建議只將新列添加到表中，即使它們將變爲空白。

但是，如果您想通過評審來完成工作，則可以始終爲每個輸出行添加22個管道。在generate_file循環中將OUTFILE_WRITELINE sOut替換爲OUTFILE_WRITELINE "||||||||||||||||||||||" & sOut。

請確定，如果您決定使用這種醜陋的黑客攻擊，那麼您會非常小心地對它進行評論，以便您和代碼的任何其他維護人員可以在需求不可避免地再次發生變化時找到並修復它。