Reading and writing in a TextFile from VBA

Sub LogInformation(LogMessage As String)
Const LogFileName As String = "C:\FOLDERNAME\TEXTFILE.LOG"
Dim txtString as String
Dim FileNum As Integer
FileNum = FreeFile ' next file number
Open LogFileName For Append As #FileNum ' creates the file if it doesn't exist
Print #FileNum, LogMessage ' write information at the end of the text file
Close #FileNum ' close the file
'For reading the file :
While not EOF(FileNum)
Line Input #FileNum, txtString ' txtString contains the line read by the command
Wend
End Sub

Import data from a text file (ADO)

The procedure below can be used to get an ADO recordset from a text file and fill in the result in a worksheet.

Sub GetTextFileData(strSQL As String, strFolder As String, rngTargetCell As Range)
' example: GetTextFileData "SELECT * FROM filename.txt", _
"C:\FolderName", Range("A3")
' example: GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer
If rngTargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"Dbq=" & strFolder & ";" & _
"Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If cn.State <> adStateOpen Then Exit Sub
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If rs.State <> adStateOpen Then
cn.Close
Set cn = Nothing
Exit Sub
End If
' the field headings
For f = 0 To rs.Fields.Count - 1
rngTargetCell.Offset(0, f).Formula = rs.Fields(f).Name
Next f
rngTargetCell.Offset(1, 0).CopyFromRecordset rs ' works in Excel 2000 or later
'RS2WS rs, rngTargetCell ' works in Excel 97 or earlier
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub


The procedure can be used like this:


Sub TestGetTextFileData()
Application.ScreenUpdating = False
Workbooks.Add
GetTextFileData "SELECT * FROM filename.txt", "C:\FolderName", Range("A3")
' GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")
Columns("A:IV").AutoFit
ActiveWorkbook.Saved = True
End Sub

Code to View Pivot Data within a date range

The following code works on the pivot with the following format :

Items	Date1	Date2	Date3	Date4
Item 1	Data	Data	Data	Data
Item 2	Data	Data	Data	Data
Item 3	Data	Data	Data	Data
Item 4	Data	Data	Data	Data

Suppose, if you have a combobox with the date range, and you want to show those date columns which fall in the given range, following is the code which you can use. The example takes a week input from the user, where, in the AN Column, the Combobox option is given and in the AO column, the actual date value is given. For example, in AN1 the value is given as February-17 to February-23, and in AO1, the value of Feb 17 is given as 39495.

Public Sub CMBMacro()
Dim prevIndx As Integer
Dim cmbValue As Long
Dim upRange As Long
Dim pivot As PivotTable
Dim pvtItm As PivotItem
Dim ifNum As Long
Dim iCounter As Integer
Dim strngArr() As String
Dim strngCn As String
Dim prvDate As Long
Dim position As Integer
Dim prevItm() As PivotItem
Dim indxChckd As Integer
Dim extDate As Integer
Dim bool As Boolean
indxChckd = Me.Range("k1").Value
cmbValue = Me.Range("AO" & indxChckd).Value - 1 ' It will take the Date selected in the combo.
upRange = cmbValue + 7 'It will add up 7 days to get the upper range of the week.
iCounter = 0
    If Not Application.EnableEvents Then
        Exit Sub
    End If
position = 2
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set pivot = Me.PivotTables(pvtName)
bool = False
    For Each pvtItm In pivot.PivotFields("Date").PivotItems
        If IsDate(pvtItm.Value) And pvtItm.RecordCount > 0 Then
            ifNum = CDate(pvtItm.Value)
            If ifNum > cmbValue And ifNum < upRange Then
                If pvtItm.Visible = False Then pvtItm.Visible = True
                    bool = True
                iCounter = iCounter + 1
            End If
        End If
    Next
    ReDim prevItm(iCounter)
    iCounter = 1
    
    For Each pvtItm In pivot.PivotFields("Date").PivotItems
        If IsDate(pvtItm.Value) And pvtItm.RecordCount > 0 Then
            ifNum = CDate(pvtItm.Value)
                If (ifNum <= cmbValue Or ifNum >= upRange) And pvtItm.Visible = True And bool Then
                    pvtItm.Visible = False
                End If
                
                If pvtItm.Visible = True Then
                    Set prevItm(iCounter) = pvtItm
                    iCounter = iCounter + 1
                End If
        End If
    Next
    
    
************************************************The Following Code sorts the date columns. It is required if the date columns are not sorted by default********* *************************************        
        For position = 1 To UBound(prevItm)
            prvDate = CDate(prevItm(position))
            For iCounter = position + 1 To UBound(prevItm)
                ifNum = CDate(prevItm(iCounter))
                    If prvDate > ifNum Then
                        prevItm(position).position = prevItm(iCounter).position
                    End If
            Next
        Next
        
        If Not bool Then
            MsgBox "No Items Found for this range.", vbCritical, "Error"
        End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Hope this has helped you all.

Thanks,
Vikas