Split info at export

[Mirica_Victor]

Hy,

I have a big table containing various informations about different erors. The info is dumped here by some append QRYs (2-3 hundred, one for each error).

In this table there in a column INFO wich contains something like:

"Name1:Value1|Name2:Value2...|Namen:Valuen"
pairs of Name:Value separated by a |

Now: the Name differs from Qry to Qry, so i can't create strict columns with every name possibly needed by all the Qrys thad put info there.

What I need is to be able to export certain report (there is a column to put a filter - so the INFO column will have the same structure) but with the info column splited.

Is there a function/module/procedure to:

Add to the export QRY instead of only one column (INFO with Name1:Value1|Name2:Value2...|Namen:Valuen ) to export n columns (the number of | found in the info +1 ), the name of the columns to be the part from the begining to the ":" (Namen) , the information in that column to be the the rest of the splitted part (Valuen)?

Somehow I found the "Text to column" option in XLS, but that means that the user might tamper the file. Also this gets the "splitter" "|" and keeps the info in that cell as "Namen:Valuen".

Has annyone dealed with something like that?

 

[Uncle Gizmo]

I don't understand your question?

Are you saying you have a field named info and you want to parse that field? (Typo corrected in bold)

 

[Mirica_Victor]

After some time, I managed to solve it with the help of my coleague, who knows more about XLS than me. In the VBA wich exports the report as a XLS I put the code:

DoCmd.SetWarnings False
    
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSh As Excel.Worksheet
    Set xlApp = New Excel.Application
    xlApp.DisplayAlerts = False
    
    DoCmd.OutputTo acOutputQuery, "Raport_XLS", acFormatXLS, NumeFis, True '***
    xlApp.Application.WindowState = xlMinimized
    xlApp.Visible = False
    
    Set xlSh = xlApp.Workbooks.Open(NumeFis).Sheets(1)
    
         
    For ColInfo = 1 To 255 ' cauta NR coloana "Informatii" - Search the number of the "Informatii" column
        If xlSh.Cells(1, ColInfo) = "Informatii" Then Exit For
    Next ' ColInfo
      
    Dim InfoTxt As String
    
    For LinInf = 2 To 1000 'parcurg coloana "Informatii", mai putin capul de tabel - go trough the "Informatii" column, less the header
        InfoTxt = xlSh.Cells(LinInf, ColInfo) 'InfoTxt pastreaza contunutul casutei "Informatii" - *InfoTxt* keeps the content of the "Informatii" cell
    If InfoTxt = "" Then Exit For 'daca nu am completat campul info, nu am pe ce sa fac formatari - If no info in that cell, nothing to split
        NrColInfoTxt = NrSepCol(InfoTxt, "|") ' e functie din modulul Spit_File - A function in a module provided later
        For Col = 1 To NrColInfoTxt
            InfoC = Split(InfoTxt, "|", , vbTextCompare)(Col - 1)
            IdCol = Trim(Split(InfoC, ":", , vbTextCompare)(0))
            ValCol = Trim(Split(InfoC, ":", , vbTextCompare)(1))
            For PasteCol = 1 To 255 ' cauta coloana de unde se poate incepe adaugarea - Searches for the column where to put the info
                If xlSh.Cells(1, PasteCol) = IdCol Then
                    xlSh.Cells(LinInf, PasteCol) = ValCol
                    Exit For
                ElseIf xlSh.Cells(1, PasteCol) = "" Then
                    xlSh.Cells(1, PasteCol) = IdCol
                    xlSh.Cells(LinInf, PasteCol) = ValCol
                    Exit For
                End If
            Next 'PasteCol
        Next 'Col
    Next ' LinInf
    
     'formateaza tabel-ul
        For j = 1 To 255
            If xlSh.Cells(1, j) = "" Then Exit For ' verif cap tabel
            For k = 2 To 1000
                If xlSh.Cells(k, 3) = "" Then Exit For
                xlSh.Cells(k, j).Borders.LineStyle = xlContinuous
                xlSh.Cells(k, j).Borders.ColorIndex = 15
            Next 'k
        Next 'j
        
        'formateaza capul de tabel
        For j = 1 To 255
            If xlSh.Cells(1, j) = "" Then Exit For
            If xlSh.Cells(1, j).Interior.ColorIndex <> 15 Then
            xlSh.Cells(1, j).Interior.ColorIndex = 36 ' light yellow
            xlSh.Cells(1, j).Borders.LineStyle = xlContinuous
            xlSh.Cells(1, j).HorizontalAlignment = xlCenter
            End If
        Next 'j
    
    xlSh.Columns("A:AA").EntireColumn.AutoFit
 End If
    
    xlApp.Visible = True
    xlApp.Application.WindowState = xlMaximized
    xlApp.ActiveWindow.DisplayGridlines = False
    xlApp.Workbooks(NumeRap & ".xls").Save
    xlApp.DisplayAlerts = True
   
    Set fs = Nothing
    Set xlSh = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing

And the above mentioned module:

Option Compare Database
  
 Public Function SplitFile(intField As Integer, strValue As String, strDelimiter As String) As String
 Dim varSplit As Variant
 If (InStr(1, strValue, strDelimiter) <= 1 Or Null) And (intField = 1) Then
   SplitFile = strValue
 Else
    Dim NumDelim As Integer
    NumDelim = 0
    Dim PosDelim As Integer
    PosDelim = 1
    
    Do
        If InStr(PosDelim, strValue, strDelimiter) Then
        NumDelim = NumDelim + 1
        PosDelim = InStr(PosDelim + 1, strValue, strDelimiter)
        End If
    Loop Until InStr(PosDelim + 1, strValue, strDelimiter) <= 1
     If intField > NumDelim + 1 Then
        SplitFile = 0
    Else
        varSplit = Split(strValue, strDelimiter, , vbTextCompare)
        SplitFile = varSplit(intField - 1)
    End If
End If
End Function
 
Public Function FcSplitVal(Field As String, DelimCol As String, Col As Integer, DelimVal As String)
 Dim SplitCol As String
SplitCol = Split(Field, DelimCol)(Col)
FcSplitVal = Split(SplitCol, DelimVal)(1)
 End Function
Public Function FcSplitId(Field As String, DelimCol As String, Col As Integer, DelimId As String)
 Dim SplitCol As String
SplitCol = Split(Field, DelimCol)(Col)
FcSplitId = Split(SplitCol, DelimId)(0)
 End Function
Public Function NrSepCol(Info As String, DelimCol As String)
 NrSepCol = 1 'teoretic exista minim o coloana
Dim PosDelimCol As Integer 'pozitia delimitatorului
PosDelimCol = 1 'Se presupune cautare de la caracterul 1
    Do
        If Nz(InStr(PosDelimCol, Info, DelimCol), 0) <> 0 Then 'elimin cazurile cu Null sau ""
        NrSepCol = NrSepCol + 1 'daca exista delimitator dupa PosDelim => mai exista o coloana
        PosDelimCol = InStr(PosDelimCol + 1, Info, DelimCol)
        End If
    Loop Until Nz(InStr(PosDelimCol + 1, Info, DelimCol), 0) = 0
End Function

Hope this helps! it shure helped me!