Snasui Excel Forum

Code: Select all

Sub Button1_Click()
    'ActiveSheet.Range("B7").CurrentRegion.Select
    ActiveSheet.Range("BA7", _
   ActiveSheet.Range("a7").End(xlDown).End(xlToLeft)).Select
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim data_line As String
    
    Dim aa As String
    ' Prompt user for destination file name.
    'DestFile = InputBox("Enter the destination filename" & _
    '  Chr(10) & "(with complete path and extension):", _
    '  "Quote-Comma Exporter")
    ' Obtain next free file handle number.
    FileNum = FreeFile()

    ' Turn error checking off.
    On Error Resume Next
    'Fix output file path to D:\xxxx.txt
     DestFile = "D:\098533326_659498369_TOLRINGDFD_" & _
              Format(Now(), "YYYYMMDD") & _
              Format(Time(), "hhmmss") & "999" & ".txt"
  
    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum
    ' If an error occurs report it and end.
    If Err <> 0 Then
      MsgBox "Cannot open filename " & DestFile
      End
    End If

    ' Turn error checking on.
    On Error GoTo 0
    Print #FileNum, "SOF"
    Print #FileNum, "# 65-949-8369"
    Print #FileNum, "# TOLRINGCCP"
    Print #FileNum, "# DFD 1.1"
    ' Loop for each row in selection.
    
    For RowCount = 1 To Selection.Rows.Count
             
              data_line = ""
  
      ' Loop for each column in selection.
      ' column 12-103 is number
      For ColumnCount = 1 To Selection.Columns.Count
         ' Write current cell's text to file with quotation marks.
         
           'column number
         If (ColumnCount >= 12) And (ColumnCount <= 103) Then
              
              'And ColumnCount
              
              
               'If ColumnCount = 11 _
              'Or ColumnCount = 14 _
             'Or (ColumnCount >= 16 _
             And ColumnCount <= 67) Then
            
            If Selection.Cells(RowCount, ColumnCount).Text <> "" Then 'not blank
         '       Print #FileNum, Selection.Cells(RowCount, _
         '       ColumnCount).Text;
             data_line = data_line & Selection.Cells(RowCount, _
               ColumnCount).Text
           
            End If
         Else ' column not number
           If Selection.Cells(RowCount, ColumnCount).Text <> "" Then 'not blank
           '    Print #FileNum, """" & Selection.Cells(RowCount, _
           '     ColumnCount).Text & """";
             data_line = data_line & """" & Selection.Cells(RowCount, _
               ColumnCount).Text & """"
           
           Else
             data_line = data_line & """" & """"
           '  Print #FileNum, """" & """",  'write "" to file
           End If
         End If
          
         
           If ColumnCount = Selection.Columns.Count Then
              ' If so, then write a blank line.
            '  Print #FileNum,
            Else
            data_line = data_line & ","
            '  Print #FileNum, ",",
            End If
 


      ' Start next iteration of ColumnCount loop.
      Next ColumnCount
            Print #FileNum, data_line
    '        Print #FileNum,
    ' Start next iteration of RowCount loop.
    Next RowCount
    ' Close destination file.
    Print #FileNum, "EOF"
    Close #FileNum
  MsgBox "Already created to file path " & DestFile
    
End Sub

Code: Select all

Format(Time(), "hhmmss") & Sheets("QPM_DFD").Range("F2").Value & ".txt"

Code: Select all

Sub Button1_Click()
    'ActiveSheet.Range("B7").CurrentRegion.Select
    ActiveSheet.Range("BA7", _
   ActiveSheet.Range("a7").End(xlDown).End(xlToLeft)).Select
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim data_line As String
    
    Dim aa As String
    ' Prompt user for destination file name.
    'DestFile = InputBox("Enter the destination filename" & _
    '  Chr(10) & "(with complete path and extension):", _
    '  "Quote-Comma Exporter")
    ' Obtain next free file handle number.
    FileNum = FreeFile()

    ' Turn error checking off.
    On Error Resume Next
    'Fix output file path to D:\xxxx.txt
     DestFile = "D:\098533326_659498369_TOLRINGDFD_" & _
              Format(Now(), "YYYYMMDD") & _
              Format(Time(), "hhmmss") & Sheets("QPM_DFDQPM_DFD").Range("F2").Value & ".txt"
  
    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum
    ' If an error occurs report it and end.
    If Err <> 0 Then
      MsgBox "Cannot open filename " & DestFile
      End
    End If

    ' Turn error checking on.
    On Error GoTo 0
    Print #FileNum, "SOF"
    Print #FileNum, "# 65-949-8369"
    Print #FileNum, "# TOLRINGCCP"
    Print #FileNum, "# DFD 1.1"
    ' Loop for each row in selection.
    
    For RowCount = 1 To Selection.Rows.Count
             
              data_line = ""
  
      ' Loop for each column in selection.
      ' column 12-103 is number
      For ColumnCount = 1 To Selection.Columns.Count
         ' Write current cell's text to file with quotation marks.
         
           'column number
         If (ColumnCount >= 12) And (ColumnCount <= 103) Then
              
              'And ColumnCount
              
              
               'If ColumnCount = 11 _
              'Or ColumnCount = 14 _
             'Or (ColumnCount >= 16 _
             And ColumnCount <= 67) Then
            
            If Selection.Cells(RowCount, ColumnCount).Text <> "" Then 'not blank
         '       Print #FileNum, Selection.Cells(RowCount, _
         '       ColumnCount).Text;
             data_line = data_line & Selection.Cells(RowCount, _
               ColumnCount).Text
           
            End If
         Else ' column not number
           If Selection.Cells(RowCount, ColumnCount).Text <> "" Then 'not blank
           '    Print #FileNum, """" & Selection.Cells(RowCount, _
           '     ColumnCount).Text & """";
             data_line = data_line & """" & Selection.Cells(RowCount, _
               ColumnCount).Text & """"
           
           Else
             data_line = data_line & """" & """"
           '  Print #FileNum, """" & """",  'write "" to file
           End If
         End If
          
         
           If ColumnCount = Selection.Columns.Count Then
              ' If so, then write a blank line.
            '  Print #FileNum,
            Else
            data_line = data_line & ","
            '  Print #FileNum, ",",
            End If
 


      ' Start next iteration of ColumnCount loop.
      Next ColumnCount
            Print #FileNum, data_line
    '        Print #FileNum,
    ' Start next iteration of RowCount loop.
    Next RowCount
    ' Close destination file.
    Print #FileNum, "EOF"
    Close #FileNum
  MsgBox "Already created to file path " & DestFile
    
End Sub

Code: Select all

Format(Time(), "hhmmss") & Sheets("QPM_DFD").Range("F2").Value & ".txt"

Code: Select all

Sub Button3_Click()
'Range("A4" & LastRow).Select
'Range("A6").End(xlDown).Select
'Range("A4").End(xlRight).Select
  ActiveSheet.Range("c5", _
   ActiveSheet.Range("a4").End(xlDown).End(xlToLeft)).Select
Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim data_line As String
    Dim RowCo As Integer
    Dim ColumnCo As Integer
    Dim aa As String
    ' Prompt user for destination file name.
    'DestFile = InputBox("Enter the destination filename" & _
    '  Chr(10) & "(with complete path and extension):", _
    '  "Quote-Comma Exporter")
    ' Obtain next free file handle number.
    FileNum = FreeFile()
    
    
    On Error Resume Next
    'Fix output file path to D:\xxxx.txt
     DestFile = "D:\098533326_659498369_TOLRINGMF_" & _
              Format(Now(), "YYYYMMDD") & _
              Format(Time(), "hhmmss") & "968" & ".txt"
  
    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum
    ' If an error occurs report it and end.
    If Err <> 0 Then
      MsgBox "Cannot open filename " & DestFile
      End
    End If

Code: Select all

Sub Button1_Click()
   ...
   Button3_Click
End Sub