Loop Through Files In A Folder Using VBA

**DocAElstein** · 09-06-2021, 02:24 PM

This post gives the macros and a file example for the last couple of posts, and begins the discussion for a working example of a text file explorer type view

.

This is the basic example macro used to get the results of the last post https://excelfox.com/forum/showthrea...ll=1#post15730

(The function, WtchaGot_Unic_NotMuchIfYaChoppedItOff(
) , is a bit too big to post, but an example can be found in the uploaded file and a full description with various code versions here: https://excelfox.com/forum/showthrea...ts-of-a-string )

Code:

Sub WhatsInWindowsClipboard() '   https://excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA?p=15730&viewfull=1#post15730   https://excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA?p=15633&viewfull=1#post15633
Dim Ws As Worksheet: Set Ws = ActiveSheet
1 Ws.Range("C7511:D7513").Select
Dim RngOrg As Range: Set RngOrg = Selection
Dim Clms As Long 'Rws As Long
 Let Clms = RngOrg.Columns.Count ': Let Rws = Rng.Rws.Count
Dim strEval As String
 Let strEval = "=" & """Rng_Item(""" & "&" & "(Row(" & RngOrg.Address & ")" & "-" & "Row(" & RngOrg.Item(1).Address & ")" & ")+1&" & """, """ & "&" & "(Column(" & RngOrg.Address & ")-Column(" & RngOrg.Item(1).Address & "))+1" & "&" & """) and Rng_Item(  """ & "&" & "(Column(" & RngOrg.Address & ")-Column(" & RngOrg.Item(1).Address & "))+1+" & "(((Row(" & RngOrg.Address & ")" & "-" & "Row(" & RngOrg.Item(1).Address & ")" & ")+1-1)*" & Clms & ")" & "&" & """ )"""   '    https://www.excelforum.com/development-testing-forum/1154829-collection-stuff-of-codes-for-other-threads-no-reply-needed.html#post4561126
 '              =       RngItm  (             (           cellRw               -                 TopLeftRw                   )+1        ,              (            cellClm           -             TopLeftClm               )+1             ) and  RngItm (               (            cellClm           -           TopLeftClm                 )+1+     (((         CellRw                 -                 TopLeftRw                   )+1-1)* ClmsCount  )              )
Debug.Print strEval ' This is what you would write in a cell:    ="Rng_Item("&(Row($C$7511:$D$7513)-Row($C$7511))+1&", "&(Column($C$7511:$D$7513)-Column($C$7511))+1&") and Rng_Item(  "&(Column($C$7511:$D$7513)-Column($C$7511))+1+(((Row($C$7511:$D$7513)-Row($C$7511))+1-1)*2)&" )"     It is the string that VBA's  Evaluate(" ")  needs to see in order to give you what you would get if you typed thaat in manually in the cells  ( In this particular example you would need to select a 3 row, 2 column range in the worksheet, add the formula to the formula bar, then do the  Ctrl+Shift*Enter  entry to get the array of resutls
2 Let Selection.Value = Evaluate(strEval)
3 Selection.Copy
' _(iii) Windows Clipboard
'Dim objCliS As DataObject   '**Early Binding.   Object from the class MS Forms, This is for an Object from the class MS Forms. This will be a Data Object of what we "send" to the Clipboard. It has the Methods I need to send text to the Clipboard. I will use this to put Things in the Clipboard. Bringing things out I will do with another Data Object
' Set objCliS = New DataObject '**Must enable Forms Library: In VB Editor do this:  Tools -- References - scroll down to Microsoft Forms 2.0 Object Library -- put checkmark in.  Note if you cannot find it try   OR IF NOT THERE..you can add that manually: VBA Editor -- Tools -- References -- Browse -- and find FM20.DLL file under C:\WINDOWS\system32 and select it --> Open --> OK.
' ( or instead of those two lines Dim obj As New DataObject which is the same ).  or  next two lines are...
Dim objCliS As Object ' ...Late Binding equivalent'
 Set objCliS = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/  https://web.archive.org/web/20140610055224/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/   ( https://web.archive.org/web/20140610024217/http://excelmatters.com/2013/05/21/transposing-an-array-using-an-in-memory-listbox/ )    http://www.eileenslounge.com/viewtopic.php?p=289020#p289020
 objCliS.GetFromClipboard
Dim TxtOut As String: Let TxtOut = objCliS.GetText() 'retrieve the text . ( In this case all I have in it is the text )
 Debug.Print TxtOut
'                Rng_Item(1, 1) and Rng_Item(  1 )   Rng_Item(1, 2) and Rng_Item(  2 )
'                Rng_Item(2, 1) and Rng_Item(  3 )   Rng_Item(2, 2) and Rng_Item(  4 )
'                Rng_Item(3, 1) and Rng_Item(  5 )   Rng_Item(3, 2) and Rng_Item(  6 )
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TxtOut)
End Sub

Example of a text file explorer type view
So what we are trying to do now is reproduce the typical Excel spreadsheet explore view with a text file looking similar. The horizontal alignment we are trying to get from the “invisible” character vbTab. The hope is that this will help the explorer type horizontal alignment to be maintained.
So we want to make a text file from the Excel spreadsheet, and we have been discussing the useful coincidence that in the ( Windows ) clipboard we have after a .Copy we have exactly what we want.
So we need do no more than copy all the spreadsheet range we are interested in, ( typically the UsedRange in our Excel spreadsheet explorer type view ) , and put the text that is then in the Windows ) clipboard into a text file.
Simple! – Like this

Code:

Sub WorksheetToTextFileOverWindowsClipboard() '  https://excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA?p=15731&viewfull=1#post15731
Rem 1 Copy to Clipboard(s)
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim RngOrg As Range: Set RngOrg = Ws.UsedRange
RngOrg.Copy
Rem 2 get text held in Windows Clipboard
' _(iii) Windows Clipboard
'Dim objCliS As DataObject   '**Early Binding.   Object from the class MS Forms, This is for an Object from the class MS Forms. This will be a Data Object of what we "send" to the Clipboard. It has the Methods I need to send text to the Clipboard. I will use this to put Things in the Clipboard. Bringing things out I will do with another Data Object
' Set objCliS = New DataObject '**Must enable Forms Library: In VB Editor do this:  Tools -- References - scroll down to Microsoft Forms 2.0 Object Library -- put checkmark in.  Note if you cannot find it try   OR IF NOT THERE..you can add that manually: VBA Editor -- Tools -- References -- Browse -- and find FM20.DLL file under C:\WINDOWS\system32 and select it --> Open --> OK.
' ( or instead of those two lines Dim obj As New DataObject which is the same ).  or  next two lines are...
Dim objCliS As Object ' ...Late Binding equivalent'
 Set objCliS = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/  https://web.archive.org/web/20140610055224/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/   ( https://web.archive.org/web/20140610024217/http://excelmatters.com/2013/05/21/transposing-an-array-using-an-in-memory-listbox/ )    http://www.eileenslounge.com/viewtopic.php?p=289020#p289020
 objCliS.GetFromClipboard
Dim TxtOut As String: Let TxtOut = objCliS.GetText() 'retrieve the text . ( In this case all I have in it is the text )
 Debug.Print TxtOut
Rem 3 put text into text file
Dim FileNum2 As Long: Let FileNum2 = FreeFile(0)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName2 As String
 Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WorksheetToTextFileOverWindowsClipboard.txt"
 Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum2, TxtOut ' write out entire text file
 Close #FileNum2

End Sub

Some results in the next post