FactoryTalk View ME 5.0 Parameter Files

Private Sub CommandButton1_Click()

    Call WorksheetLoop 'UserForm1.Show

End Sub

'This subroutine will loop through all worksheets in a workbook.
'For each worksheet, the sub will loop through all cells in a specified column range.
'Each cell in that range will be copied to an encoding stream in UTF-16LE format.
'The compiled stream will be saved as a parameter file for use in RSView Studio.
'The parameter file will have had the BOM removed due to incompatibility of the BOM with FTView.
'-------------------------------------
Sub WorksheetLoop()

    'Dim variables for subroutine.
    Dim wB As Workbook
    Dim wBSheets As Range
    Dim wS As Worksheet
    Dim wSCell As Range
    Dim wSCellRange As Range
    Dim lastRow As Long
    Dim fileName As String
    Dim filePath As String
    
    'Sets active workbook and preps for cycling through day values.
    Set wB = Application.ActiveWorkbook
    filePath = wB.Worksheets(1).Cells(2, 1)
    
    'Loop through all worksheets in workbook.
    For Each wS In wB.Worksheets
      
        'Identify last row in column with data.
        wS.Activate
        fileName = wS.Cells(1, 1)
        lastRow = wS.Range("F2").CurrentRegion.Rows.Count
        
        'Create range for cell loop.
        Set wSCellRange = wS.Range("F2:F" & lastRow)

        'Dimension and create encoding stream.
        Dim UTFStream As Object
        Set UTFStream = CreateObject("adodb.stream")
        UTFStream.Type = adTypeText
        UTFStream.Mode = adModeReadWrite
        UTFStream.Charset = "UTF-16LE"
        UTFStream.LineSeparator = adCRLF
        UTFStream.Open
        
        'Loop through cell values in range and write as text with line seperator to stream.
        For Each wSCell In wSCellRange
            UTFStream.WriteText wSCell, 1
        Next wSCell
    
        'Modify stream to skip UTF-16 Little Endian Byte Order Mark (BOM).
        UTFStream.Position = 2
    
        'Dimension and create binary stream.
        Dim BinaryStream As Object
        Set BinaryStream = CreateObject("adodb.stream")
        BinaryStream.Type = adTypeBinary
        BinaryStream.Mode = adModeReadWrite
        BinaryStream.Open
    
        'Copy encoding stream to binary stream, having previously stripped BOM (first 2 bytes).
        UTFStream.CopyTo BinaryStream
        
        '--------------------
        'Uncommenting the below SaveToFile line will write the encoding stream w/ BOM to a text file.
        'This will show that the BOM has been removed by comparing encodings of the encoding and binary result.
        'Encodings can be compared using software such as Notepad++.
        'UTFStream.SaveToFile "C:\Users\ - Insert Your Username Here - \Desktop\UTFstream.txt", adSaveCreateOverWrite
        '--------------------
        
        'Clear encoding stream for next worksheet.
        UTFStream.Flush
        UTFStream.Close
    
        'Save binary stream to parameter file, using cell values to determine file name and path.
        BinaryStream.SaveToFile filePath & "\" & fileName & ".par", adSaveCreateOverWrite
        BinaryStream.Flush
        BinaryStream.Close
      
    'Run next worksheet.
    Next wS
    
    'Reset active sheet to first worksheet.
    wB.Worksheets(1).Activate
    
End Sub