VBA для добавления 22 труб (|) в текстовый файл с помощью макроса

Я надеюсь, что вы можете помочь мне иметь часть кода, и что он делает, так это получение информации из двух листов excel и перенос их в два текстовых документа для потребления в базе данных.

Код, который у меня хорошо работает, но 22 базы данных были добавлены в базу данных, где текстовый файл предназначен для потребления, поэтому мне нужно поставить 22 трубы (|) перед идентификатором компании в файле Notepad

Первый рисунок представляет собой лист Excel, в котором сотрудники могут вводить данные введите описание изображения здесь

Второй рис. Показывает лист excel, где данные сортируются из «Шага закрытия собрания», и макрос берет данные для преобразования в текст. Этот лист сортировки называется «Template-EFPIA-iTOV», столбцы серого – это то, что макро-фотографии

введите описание изображения здесь

В приведенном ниже рисунке вы можете увидеть, что идентификатор компании – последний столбец в «Шаблон-EFPIA-iTOV введите описание изображения здесь

Ниже показано, как лист «Шаблон-EFPIA-iTOV» представлен в тексте введите описание изображения здесь

Вот идентификаторы компании в текстовом файле введите описание изображения здесь

Поскольку база данных назначения теперь имеет дополнительные 22 столбца перед идентификатором компании, мне нужно, чтобы мой макрос помещал 22 файла (|) перед идентификатором компании в текстовом документе.

Лист Excel «Клиент шаблона EFPIA» также конвертируется в текст, но это прекрасно и не нуждается в поправках.

Мой код ниже. Как всегда, любая помощь очень ценится.

Pic Macro front end

введите описание изображения здесь

КОД

'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 

… и затем динамически сохраняет все строки в текстовом файле с разделителями по каналам, я настоятельно рекомендую просто добавлять новые столбцы в свой лист, даже если они будут пустыми.

Однако, если вы хотите, чтобы присяжные выстроились, чтобы выполнить эту работу, вы всегда можете добавить 22 трубы в каждую строку вывода. Замените OUTFILE_WRITELINE sOut в цикле generate_file с помощью OUTFILE_WRITELINE "

|" & sOut OUTFILE_WRITELINE "

|" & sOut .

Убедитесь, что если вы решите использовать этот уродливый хак, вы очень тщательно прокомментируете его, чтобы вы и любые другие сопровождающие кода могли находить и исправлять его, когда требования неизбежно меняются снова.

Давайте будем гением компьютера.