title: VBA array write to .txt file
body: <p>I am having problems getting my array to write to a txt.file correctly.
  What it does currently, is display the results in a msgbox so we can see it straight away, and writes only some of the data that appeared in that msgbox into the txt.file.</p>
  
  <p>I tried using 'Append' which does display all the data, but of course, it only adds the data to the txt.file rather than replacing what is already in there.
  'Output' I think is the only way of getting it to write all the data into the txt.file, and then also replace it each time.</p>
  
  <p>Sadly, I cannot get it to work with 'output'. It currently only writes the last line of data that was in the array.</p>
  
  <p>I assume I need some kind of loop, but I cannot figure out a way to get it to work successfully.</p>
  
  <p>My code is below. Any help would be appreciated.</p>
  
  <pre><code>Private Function Expired(ByRef msg As String, ByRef var1 As Variant, ByRef 
  var2 As Variant, ByRef var3 As Variant) As String
  Dim sFilePath As String
  
  
  Dim FileNumber
  
  
  If Len(msg) = 0 Then msg = "Persons with EXPIRED Safeguading 
  Certificates:@NL@NL"
  Expired = msg &amp; "@var1 @var2 (@var3)@NL"
  Expired = Replace(Expired, "@var1", var1)
  Expired = Replace(Expired, "@var2", var2)
  Expired = Replace(Expired, "@var3", var3)
  
  
  sFilePath = "R:\HR and Admin\Expired.txt"
  FileNumber = FreeFile
  If (VBA.Len(VBA.Dir(sFilePath))) = 0 Then MsgBox "File Does not exists": End
  Open sFilePath For Output As #FileNumber 
  Print #FileNumber , var1, var2, var3
  
  
  Close #FileNumber
  </code></pre>
  
  <p>The following is all the code for the vba sheet:</p>
  
  <pre><code>    Public Sub Expire_New(ByRef ws As Worksheet, ByVal Name As String)
  
  Dim msg(1 To 3) As String
  Dim x           As Long
  Dim nDx         As Long
  Dim dDiff       As Long
  
  'Establish the location of the first cell (range) of the Safegaurding Training block
  'Find the first instance of Safeguarding Training on the sheet
  Dim sgTrainingCol As Range
  With ws.Range("A1:AA1000")  'Using something large to provide a range to search
      Set sgTrainingCol = .Find("Safeguarding Training", LookIn:=xlValues)
  End With
  
  'Establish the location of the first cell (range) of the heading column
  'for the table on the sheet. Find the first instance of what is contained
  'in mTitleFirstHeadingColumn
  Dim HeadingRangeStart As Range
  With ws.Range("A1:AA1000")  'Using something large to provide a range to search
      Set HeadingRangeStart = .Find(Name, LookIn:=xlValues)
  End With
  
  Dim TrainingInfoRange As Range
  Dim personFNSR As Range
  With ws
      'finds the last row of the Heading column that has data, there can NOT be any empty rows
      'in the middle of this search.  It assumes that the name column date is contigous until
      'reaching the end of the data set.
      x = .Cells(HeadingRangeStart.Row, HeadingRangeStart.Column).End(xlDown).Row
      'Set the TrainingInfoRange to point to the data contained in the 4 columns under Safeguarding Training
      Set TrainingInfoRange = .Range(.Cells(sgTrainingCol.Row + 2, sgTrainingCol.Column), .Cells(x, sgTrainingCol.Column + 3))
      'Set pseronFNSR to the First Name/Name, Surname range
      Set personFNSR = .Range(.Cells(HeadingRangeStart.Row + 1, HeadingRangeStart.Column), .Cells(x, HeadingRangeStart.Column + 1))
  End With
  
  'I am a big fan of collections and scripting dictionaries.
  'They make code easier to read and to implement.
  Dim trainingDate As Scripting.Dictionary
  Set trainingDate = CopyRngDimToCollection(personFNSR, TrainingInfoRange)
  
  'This boolean will be used to control continued flow of the
  'macro.  If NoExpiredTraining gets set to false, then there
  'are people who must complete training.
  Dim NoExpiredTraining As Boolean: NoExpiredTraining = True
  
  'person training inquiry object - see class definition
  Dim personInquiryTraining As clPersonTraining
  
  'this is an index variable used to loop through items
  'contained in the Scripting Dictionary object
  Dim Key As Variant
  
  For Each Key In trainingDate.Keys
      'Assing the next object in the trainingDate Scripting Dictionary
      'to the person training inquiry object
      Set personInquiryTraining = trainingDate(Key)
      'Check to see if there are any training issues
      'if so, then set NoExpiredTraining to False
      'because there is expired, expiring or missing training
      If personInquiryTraining.ExpiringTraining _
        Or personInquiryTraining.NoTraining _
        Or personInquiryTraining.TrainingExpired Then
          NoExpiredTraining = False
      End If
  Next
  
  If NoExpiredTraining Then
      'msg(4) = MsgBox("There are either no ...
      'is only used if want to do something based on
      'what button the user pressed.  Otherwise use
      'the Method form of MsgBox
      MsgBox "There are either no expired safeguarding certificates, " _
           &amp; "or no certificate expiring within the next 31 days.", _
           vbInformation, "Warning"
      Exit Sub
  End If
  
  'If this code executes, then there is expired training.
  'Let's collect the status for each individual
  For Each Key In trainingDate.Keys
      Set personInquiryTraining = trainingDate(Key)
      If personInquiryTraining.TrainingExpired _
        And personInquiryTraining.trainingDate &lt;&gt; DateSerial(1900, 1, 1) Then 'Training is expired
          msg(1) = Expired(msg(1), _
                personInquiryTraining.firstName, _
                personInquiryTraining.surName, _
                personInquiryTraining.trainingExpiryDate)
      End If
      If personInquiryTraining.ExpiringTraining _
        And personInquiryTraining.trainingExpiryDate &lt;&gt; DateSerial(1900, 1, 1) Then 'Training is expiring
          msg(2) = Expiring(msg(2), _
                personInquiryTraining.firstName, _
                personInquiryTraining.surName, _
                personInquiryTraining.trainingExpiryDate, _
                DateDiff("d", Date, personInquiryTraining.trainingExpiryDate))
      End If
      If personInquiryTraining.NoTraining Then 'Training is None
          msg(3) = NoTraining(msg(3), _
                personInquiryTraining.firstName, _
                personInquiryTraining.surName, _
                "NONE")
      End If
  Next
  
  'Because of the Exit Sub statement above, the code bwlow
  'will only execute if there are expired, expiring or missing
  'training
  For x = LBound(msg) To UBound(msg)
      msg(x) = Replace(msg(x), "@NL", vbCrLf)
      If Len(msg(x)) &lt; 1024 Then
      Select Case msg(x)
  Case msg(1)
      If Len(msg(x)) &amp; vbNullString &gt; 0 Then
          'MsgBox "(If this box is blank, there is nothing Expired)" &amp; vbCrLf &amp; vbCrLf &amp; msg(x), vbExclamation, "Safeguarding Certificate Notification"
          MsgBox msg(x), vbCritical, "Safeguarding Certificate Notification"
          End If
  Case msg(2)
      If Len(msg(x)) &amp; vbNullString &gt; 0 Then
          'MsgBox "(If this box is blank, there is nothing Expired)" &amp; vbCrLf &amp; vbCrLf &amp; msg(x), vbExclamation, "Safeguarding Certificate Notification"
          MsgBox msg(x), vbExclamation, "Safeguarding Certificate Notification"
          End If
  Case msg(3)
      If Len(msg(x)) &amp; vbNullString &gt; 0 Then
          'MsgBox "(If this box is blank, there is nothing Expired)" &amp; vbCrLf &amp; vbCrLf &amp; msg(x), vbExclamation, "Safeguarding Certificate Notification"
          MsgBox msg(x), vbCritical, "Safeguarding Certificate Notification"
          End If
          End Select
  Else
       MsgBox "String length for notification too long to fit into this MessageBox", vbExclamation, "Invalid String Length to Display"
  End If
  
  Next x
  
    End Sub
  
  
  
  
  '***************************************************************************
     '**
      '** This fucntion copies all rows of data for the column specified into
        '** a scripting dictionary
        Private Function CopyRngDimToCollection(ByRef mFNSR As Range, ByRef 
        mTrainInfo) As Scripting.Dictionary
  
  Dim retVal As New Scripting.Dictionary
  'nDx will become a key for each of the scripting dictionary items
  Dim nDx As Long: nDx = 1
  'person training inquiry object - see class definition
  Dim personTraining As clPersonTraining
  
  Dim mRow As Range
  For Each mRow In mFNSR.Rows
      'instantiate a new person training inquiry object
      Set personTraining = New clPersonTraining
      With personTraining
          .firstName = mRow.Value2(1, 1)
          .surName = mRow.Value2(1, 2)
      End With
      retVal.Add nDx, personTraining
      nDx = nDx + 1
  Next
  nDx = 1
  
  For Each mRow In mTrainInfo.Rows
      'Retrieve the person training inquiry object
      'from the scripting dictionary (retVal)
      Set personTraining = retVal(nDx)
  
      'Add the training data information to
      'the person training inquiry object
      With personTraining
          'Next two equations determine if the excel range has a null value
          'if so then the person training inquiry object's date field is set to a
          'default value of 1-1-1900 - this could be any valid date
          'otherwise the value is set to what is in the excel range from the sheet
          .trainingDate = IIf(mRow.Value2(1, 1) = vbNullString, DateSerial(1900, 1, 1), mRow.Value2(1, 1))
          .trainingExpiryDate = IIf(mRow.Value2(1, 2) = vbNullString, DateSerial(1900, 1, 1), mRow.Value2(1, 2))
          .trainingLevel = mRow.Value2(1, 3)
          .certSeenBy = mRow.Value2(1, 4)
      End With
      'Update the object stored at the current key location
      'given by the value of nDx
      Set retVal(nDx) = personTraining
      nDx = nDx + 1
  Next
  
  'Set the return value for the function
  Set CopyRngDimToCollection = retVal
  
  End Function
  
     Private Function Expired(ByRef msg As String, ByRef var1 As Variant, 
   ByRef var2 As Variant, ByRef var3 As Variant) As String
   Dim sFilePath As String
   Dim FileNumber
  
  
      If Len(msg) = 0 Then msg = "Persons with EXPIRED Safeguading 
     Certificates:@NL@NL"
  Expired = msg &amp; "@var1 @var2 (@var3)@NL"
  Expired = Replace(Expired, "@var1", var1)
  Expired = Replace(Expired, "@var2", var2)
  Expired = Replace(Expired, "@var3", var3)
  
    sFilePath = "R:\HR and Admin\Expired.txt"
    FileNumber = FreeFile
    If (VBA.Len(VBA.Dir(sFilePath))) = 0 Then MsgBox "File Does not exists": 
    End
  
       Open sFilePath For Output As #FileNumber
       Print #FileNumber, var1, var2, var3
  
      Close #FileNumber
  
  
  
     End Function
  
      Private Function Expiring(ByRef msg As String, ByRef var1 As Variant, 
     ByRef var2 
    As Variant, ByRef var3 As Variant, ByRef d As Long) As String
   Dim sFilePath As String
    Dim FileNumber
  
  If Len(msg) = 0 Then msg = "Persons with EXPIRING Safeguarding 
  Certificates:@NL@NL"
  
  Expiring = msg &amp; "@var1 @var2 (@var3) (@d days remaining)@NL"
  Expiring = Replace(Expiring, "@var1", var1)
  Expiring = Replace(Expiring, "@var2", var2)
  Expiring = Replace(Expiring, "@var3", var3)
  Expiring = Replace(Expiring, "@d", d)
  
    sFilePath = "R:\HR and Admin\Expiring.txt"
    FileNumber = FreeFile
    If (VBA.Len(VBA.Dir(sFilePath))) = 0 Then MsgBox "File Does not exists": 
    End
  
   Open sFilePath For Output As #FileNumber
    Print #FileNumber, var1, var2, var3
  
    Close #FileNumber
  
  
    End Function
  
     Private Function NoTraining(ByRef msg As String, ByRef var1 As Variant, 
     ByRef var2 As Variant, ByRef var3 As Variant) As String
    Dim sFilePath As String
    Dim FileNumber
   If Len(msg) = 0 Then msg = "SAFEGUARDING TRAINING NOT COMPLETED FOR: 
   @NL@NL"
  
  NoTraining = msg &amp; " @var1 @var2@NL"
  NoTraining = Replace(NoTraining, "@var1", var1)
  NoTraining = Replace(NoTraining, "@var2", var2)
  NoTraining = Replace(NoTraining, "@var3", var3)
  
    sFilePath = "R:\HR and Admin\NoTraining.txt"
    FileNumber = FreeFile
    If (VBA.Len(VBA.Dir(sFilePath))) = 0 Then MsgBox "File Does not exists": 
    End
  
     Open sFilePath For Output As #FileNumber
     Print #FileNumber, var1, var2, var3
  
     Close #FileNumber
  
  
     End Function
  </code></pre>