PDA

View Full Version : variations on import vba



Sayre
07-01-2014, 02:25 PM
Hello! New to vbax.

I'm using the code originally posted by Kenneth Hobbs in thread # 46276. Reposting the code here per request of Kenneth Hobbs.

I'm new to this board but not new to vba although still pretty intermediate at best but I love researching and putting the assistance I get to good use. I have a large need for variations on import files macros which I never needed before. Excuuse the size of my request, please feel free to help on any little portion of it if you can, I appreciate anything I can get on this. This is great code to start with!

Here is Kenneth's code.

Part 1


' Windows folder and file details for windows versions and a VBA macro:

Sub FileDetails()

'SpeedOn

ListMyFiles ThisWorkbook.Path, Range("A2"), True, "Text Document"

ActiveSheet.UsedRange.Columns.AutoFit
Range("C:C").HorizontalAlignment = xlCenter
Range("F:H").HorizontalAlignment = xlCenter
Range("A1").Activate
'SpeedOff
End Sub

' Tools > References > Microsoft Scripting Runtime
' Tools > References > Microsoft Shell Controls and Automation
Sub ListMyFiles(mySourcePath As String, sRow As Range, _
Optional IncludeSubfolders As Boolean = True, Optional FileType As String = "")

Dim myObject As Scripting.FileSystemObject
Dim mySource As Scripting.Folder
Dim myFile As Scripting.File
Dim mySubFolder As Scripting.Folder
Dim wShell As Shell

Set wShell = New Shell
Set myObject = New Scripting.FileSystemObject
Set mySource = myObject.GetFolder(mySourcePath)

'On Error Resume Next
For Each myFile In mySource.Files
'If LCase(myFile.Path) = LCase(ThisWorkbook.Path) Then GoTo NextFile
If myFile.Type = FileType Or FileType = "" Then
With sRow
.Value2 = myFile.Path
.Offset(, 1).Value2 = myFile.Name
.Offset(, 2).Value2 = myFile.Size
.Offset(, 3).Value2 = myFile.Type
.Offset(, 4).Value2 = myFile.DateLastModified
.Offset(, 4).NumberFormat = "mm/dd/yyyy"
End With

With wShell.Namespace(mySource.Path)
'sRow.Offset(, 5).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 151) 'Frame width Vista=265, Width=151 Win7.
'sRow.Offset(, 6).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 153) 'Frame height Vista=263, Height=153 Win7.
'sRow.Offset(, 7).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 36) 'Duration value, XP=21. 36 in Vista and Win7.
'srow.offset(, 8).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 36) 'Duration word, XP=21. 36 in Vista and Win7.
End With

' Hyperlink
'sRow.Offset(, 8).Hyperlinks.Add sRow.Offset(, 8), myFile.Path, , , myObject.GetBaseName(myFile.Name)

Set sRow = sRow.Offset(1)
End If
NextFile:
Next

If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
ListMyFiles mySubFolder.Path, sRow, True, FileType
Next
End If
End Sub
[/vba]

This part works fine but I'd like it to be able to do .txt, .csv, etc... If I could list the types I want to search for in col A of 'mySheet' (partial value string *like* match starting row 2 through endup.xlrow) that would be great.

If not I can work with hard coding but I can't seem to figure out how to change this line of code:
[code]ListMyFiles ThisWorkbook.Path, Range("A2"), True, "Text Document"

so that it will search for not only "Text..." but also "comma separated...", or .out files, etc...


Here is part 2:


Sub Test_ImportTxtData()
Dim s1 As Worksheet, s2 As Worksheet
Dim c As Range, s1Range As Range, r As Range

Set s1 = Worksheets("Sheet1")
Set s1Range = s1.Range("A3:A" & s1.Range("A" & Rows.Count).End(xlUp).Row)
Set s2 = Worksheets("Sheet2")
Set r = s2.Range("A1")
Set c = s1.Range("A2")

' Import first txt file with header row.
ImportTxtData c.Value2, c.Offset(0, 1).Value2, s2, r, True

' Import others if needed.
If s1Range.Address(False, False) <> "A3" Then Exit Sub
For Each c In s1Range
Set r = s2.Range("A" & Rows.Count).End(xlUp).Offset(1)
ImportTxtData c.Value2, c.Offset(0, 1).Value2, s2, r
'Delete header row and mark first row added.
r.EntireRow.Delete shift:=xlUp
Rows(ActiveCell.Row).EntireRow.Font.Italic = True
Next c
End Sub


Sub ImportTxtData(sPath As String, sName As String, dSheet As Worksheet, _
dRange As Range, Optional tbFieldNames As Boolean = False)
Dim q As String, s As String
s = q & "TEXT;" & sPath & q
With dSheet.QueryTables.Add(s, dRange)
.Name = sName
.FieldNames = tbFieldNames
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub


Would love this to be modified so it can import any file type in the list created from part 1, not just "TEXT;"

Also, would be great to be able to keep a list of partial list of values (col B of 'mySheet' strating row 2 through .endup xlrow) that the macro would run through the list on 'Sheet1', find the *like* partial string match, then import that entire file in 'Sheet2'.



I found this code that is close, but it only does one key word that must be hard coded into the script:



Sub ImportCSVsWithReference()
'Author: Jerry Beaucaire
'Date: 10/16/2010
'Summary: Import all CSV files from a folder into a single sheet
' adding a field in column A listing the CSV filenames

Dim wbCSV As Workbook
Dim wsMstr As Worksheet: Set wsMstr = ThisWorkbook.Sheets("sysinfo")
Dim fPath As String: fPath = "U:\Childerns_Hospital\Analysis Project\HNAS data\SMUDiagnostics\mgr\ExportedStats_20140506_093011_035" 'path to CSV files, include the final \
Dim fCSV As String

'If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
= vbYes Then wsMstr.UsedRange.Clear

'Application.ScreenUpdating = False 'speed up macro

fCSV = Dir(fPath & "*.csv") 'start the CSV file listing

Do While Len(fCSV) > 0
'open a CSV file
Set wbCSV = Workbooks.Open(fPath & fCSV)
'insert col A and add CSV name
Columns(1).Insert xlShiftToRight
Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
'copy date into master sheet and close source file
ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
wbCSV.Close False
'ready next CSV
fCSV = Dir
Loop

Application.ScreenUpdating = True
End Sub



Sub testCSVimport()

'Dimension any other variables to your preference
Dim ResultArray(100000)

'Open the workbook with your list of acceptable data
Workbooks.Open Filename:="\\dfs\fs\users\Apollo\Apollo_5151308.0001_HDS_RACK.xlsx"

'Set LS to represent the path to the workbook with your list
Set LS = Workbooks("list.xlsx").Worksheets("Sheet1")

'open the csv file
Open "C:\Documents and Settings\Robert\My Documents\text.csv" For Input As #1

'begin to loop through the csv file line by line
Do While Not EOF(1)
Line Input #1, Data
'If your data is really consistent, then you can skip to the Mid to pull out the element _
you wish to compare, otherwise, you need to count commas until you have bracketed the element
datalength = Len(Data)
For a = 1 To datalength
If Mid(Data, a, 1) = "," Then
CommaCount = CommaCount + 1
If CommaCount = 2 Then MidStart = a + 1
If CommaCount = 3 Then
MidLng = a - MidStart
Exit For
End If
End If
Next a
'Use the data to extract the element you wish to compare
Element = Mid(Data, MidStart, MidLng)

'Use the Match function to compare your element to your list
On Error Resume Next
MatchVal = Application.WorksheetFunction.Match(CDbl(Element), LS.Range("A1:A5"), 0)
'If there is an error, then Err will not equal 0, so you can ignore that data. If Err = 0, then _
move the data into the ResultArray
If Err = 0 Then
ArrayCount = ArrayCount + 1
ResultArray(ArrayCount) = Data
End If
'Return CommaCount variable to 0
CommaCount = 0
Loop

'Close csv file and List file
Close #1

Workbooks("List.xlsx").Close

'I built this in a workbook, so I just dump the data. You can create a workbook from scratch
Worksheets("Sheet1").Activate

For b = 1 To ArrayCount
Cells(b, 1) = ResultArray(b)
Next b

'Here you have filtered data that you can use text to columns on

End Sub



This is a lot I know, any part of this that anyone can help with would be much appreciated!

Kenneth Hobs
07-01-2014, 04:31 PM
When using code tags, use them like (code)your code(/code) and replace ()'s with []'s. Or just click the # to insert the code tags. This forum used to use vba code tags which made this forum unique in code style but no more.

While it is easy enough to do the first part, my question may also relate to your other questions. Keep in mind that short threads get solutions faster than long ones. Do you understand that a file's type "Text Document" as used in my code includes files types like .txt, .csv, etc.? In a related way, the "TEXT" is used for importing text data. Trying to import binary files is usually not of much use.

To do the first thing, if you are using column A data for file extensions, the code will need to delete that data or create a new sheet. I will see about doing that tomorrow.

As for the last code, I don't know what one part needs hard coding. You can always add input parameters to add more versatility to your routines.

Sayre
07-01-2014, 04:47 PM
Thank you Kenneth for your feedback. Yes I messed up on one of the code tags. I was trying to get this all down quickly before a meeting. I'll slow down for my next post. In any case, about "TEXT" I have some CSV files in my directory that did not look like they were making it into the list on 'Sheet1'. I'll double check that and get back. About the column 'A' thing. I was hoping for something that would like this:



Sub FindAndKeep_Partial_Match()
Dim strTitle As String, strOrder As String
For i = 20 To Sheets("START").Cells(Rows.Count, 2).End(xlUp).Row
If Sheets("START").Cells(i, 2).Value <> "" Then
strTitle = UCase(Sheets("START").Cells(i, 2).Value)
For j = 2 To Sheets("New_Invoices").Cells(Rows.Count, 11).End(xlUp).Row
strOrder = UCase(Sheets("New_Invoices").Cells(j, 11).Value)
If strOrder Like "*" & strTitle & "*" Then Sheets("New_Invoices").Cells(j, 130).FormulaR1C1 = "keep me"
Next j
End If
Next i
'Unload UserForm1
For i = 20 To Sheets("START").Cells(Rows.Count, 2).End(xlUp).Row
If Sheets("START").Cells(i, 2).Value <> "" Then
strTitle = UCase(Sheets("START").Cells(i, 2).Value)
For j = 2 To Sheets("New_Invoices").Cells(Rows.Count, 24).End(xlUp).Row
'If Cells(j, 2).Value <> "" Then
strOrder = UCase(Sheets("New_Invoices").Cells(j, 24).Value)
If strOrder Like "*" & strTitle & "*" And Sheets("New_Invoices").Cells(j, 130).FormulaR1C1 = "" Then Sheets("New_Invoices").Cells(j, 130).FormulaR1C1 = "keep me"
'End If
Next j
End If
Next I


Which goes through column B on "START" tab from row 20 down, looks for partial string match of each value on another tab called "New_Invoices" and does something when it gets a match. I'm hoping for something like this but instead of searching for matches on another tab in the sheet, it is searching for matches in a file directory of unopened files. If I can get the syntax down for this kind of thing in a few ways I can do a lot with it, just have not delved into vba for that before. Hope that clears it up some, apologies if my communication is clumsy.

Kenneth Hobs
07-01-2014, 05:28 PM
That looks fairly involved. Can you make a very short example file and attach so that can best help. Showing a before and after so we can see the logic often helps us get you going the quickest.

Sayre
07-01-2014, 06:43 PM
That's fair, thank you! I'll prepare it hopefully in the next day or so.

Sayre
07-19-2014, 05:42 PM
OK Kenneth Hobs I finally got some stuff together that I think does a better job representing what I'm after. Thanks for any help with a macro you can provide!

First attachment called 'Example_For_Post.xlsx' contains 2 tabs.1st tab called 'Parent folders tab' contains a list of folder paths which will always be there prior to macro execution. In this case there are 11 folder paths represented in UNC format but the list can vary widely in number of entries, could be over 2000 folders. One folder path represented per row, the loop needs to execute on all of them no matter how many.

Each folder has many subfolders. In this case I need values from 2 files found in 2 subfolders for each parent folder listed.

Subfolder 1 is called 'etc'. Subfolder 2 is called 'sysinfo'.

The 2nd tab in the xlsx file is called 'MACRO_Results' and the macro needs to write everything here.



Macro
Step 1: Macro puts an integer in column A of 'MACRO_Results' tab for numbering purposes, starting with 1001 in row 7. 1001 will become the number of the 1st entry representing the 1st parent folder (which can be found in column A row 1 in 'Parent folders tab') to be acted on in the macro. The macro then does steps 2 and 3 below, and then puts 1002 in Row 8 of 'MACRO_results' tab and does it all again for the 2nd entry in 'Parent folders tab'.

Step 2: Macro goes to 'etc' folder of the first entry on 'Parent folders tab', locates the file called 'hostname.bge0', reads the contents (should be just one word in the file), and places the string in column B row 7 of the 'MACRO_Results' tab. This one should be easy enough, I hope ;0)

Step 3: This is where it gets trickier and I hope this is possible. Macro goes to 'sysinfo' folder of first entry on 'Parent folders tab', locates the file called 'ifconfig-a.out', and reads 2 different values located in 2 different places on this file, which can vary every time but will always be preceded by a constant key value.

The IP port name: In the 'ifconfig-a.out' file, the IP port name happens to be called 'bge0' and always comes right after the 1st instance of the word "ff000000 " which is the key value (there's a 2nd instance of this but that is not needed). So the macro needs to scan the .out file until it gets to the key word, then grab the very next string value which will be the port name: 'bge0' in the case of the first entry from parent tab.

The IP address: Same action happens here but now the key value is the 2nd instance of the word 'inet'. This word appears once before but that value is not important here. So the macro scans to the second instance of the key value 'inet' and then grabs the very next string value which will be the IP address: '10.2.24.12' in the case of the first entry from parent tab.

The macro then concatenates the 2 string values it found together with a slash in between and places the new concatenated string into column C row 7 of the 'MACRO_Results' tab.

This will complete the first loop, the macro will then go on to repeat the same thing for all other entries on the 'Parent folders tab' until finished with all of them.

Whew! I hope that makes sense. I know this is a lot but it will be incredible for me if it can be pulled off as this is currently a manual process that has t happen to thousands of folder directories. Let me know if any further clarification needed and I'll respond quickly. I have included 3 attachments.

1) The xlsx with the parent folder list sample as well as example of what the results should look like, 11991
2) The 'ifconfig-a.out' file for the first entry, 11992 - NOTE: this forum won't let me upload .out files so I saved it with a .xlsx at the end to get past that, I hope it still comes through as a .out file though. I really need the macro to be able to read .out format.
3) The 'hostname.bge0' file for the first entry, 11993 - NOTE: same issue here. I resaved it with a .xlsx at the end to get it past the upload filter. Really hope this works.

Thanks a ton for any assistance you can provide!

westconn1
07-19-2014, 11:32 PM
the code posted here passes the text document string as an optional parameter, but you can omit parameter, or ignore the parameter within the procedure
within the listmyfiles procedure you can have a select case to treat different file types

If myFile.Type = FileType Or FileType = "" Thenreplace this conditional criteria with the different file types you want to handle, some may require different processes

For Each myfile In mySource.Files
Select Case myfile.Type
Case "Text document", "" ' effectively the same as your current criteria
'your existing code here
Case "Microsoft Excel Comma Separated Values File" '.csv
' while .csv files are just text, excel see them differently and may well require different treatment

'case for each other file type you want to process, if they need special handling,
'if they can be handled identically to some others they can be grouped, as in the first Case example
Case "Microsoft Excel Worksheet"
'if you want to do some handling for workbooks
Case Else
'all files that did not fit one of the above,
'you could just use to make a list of files that were not processed
' or omit if you do not need to do anything
End Select

Nextthis will ignore any passed file type parameter, and handle all file types you list

while you have broken down your requirements into sections, it is a big ask to do all at once, others may answer different sections, or i will look at another part later
please indicate, as you go, which parts have solutions and which still require assistance

Sayre
07-21-2014, 08:47 AM
Thanks westconn1! Not sure exactly what to do with this yet, although I'm sure it will become clear later on. My code is below, it works for step 1 and (partially) for step 2. I am hoping someone can help with one problem I am having with step 2.

Here is my current code:



Sub Search_TypeID_ANYFiles()

Dim ParentFolder As String, SubFolder1 As String, Subfolder2 As String, SubFolderFile As String
Dim strFindWhat As String, strText As String
Dim FF As Long, n As Long, m As Long
Dim Counter As Long, MatchCount As Long
Dim strList() As String
Dim sPath As String
Dim Index As Integer
Dim ShtLastRow As Long
'Dim i, j

Index = 1001
ShtLastRow = Sheets("ServerList").Cells(Rows.Count, 1).End(xlUp).Row
ShtLastRow2 = ShtLastRow + 6
'For i = 1 To Sheets("ServerList").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ShtLastRow
ParentFolder = Sheets("ServerList").Cells(i, 1).Value 'Root folder for the files

SubFolder1 = ParentFolder & "\etc"

SubFolderFile = Dir(SubFolder1 & "\" & "hostname.*")


sPath = SubFolder1 & SubFolderFile

'For j = 7 To Sheets("MACRO_Results").Cells(Rows, iRows).End(xlUp).Row
For j = 7 To ShtLastRow2
' Sheets("ServerList").Range ("A1:A" & Sheets("ServerList").Range("A" & Rows.Count).End(xlUp).Row)

If Cells(j, 1) = "" Then
Cells(j, 1) = Index
Index = Index + 1
Cells(j, 2) = LoadTextFile(sPath)
GoTo skip
End If
Next j
skip:
Next i

End Sub
'Option Explicit

' \\ Function to return the full content of a text file as a string
Public Function LoadTextFile(sFile As String) As String
Dim iFile As Integer

'On Local Error Resume Next
' \\ Use FreeFile to supply a file number that is not already in use
iFile = FreeFile

' \\ ' Open file for input.
Open sFile For Input As #iFile

' \\ Return (Read) the whole content of the file to the function
LoadTextFile = Input$(LOF(iFile), iFile)

Close #iFile

End Function


The problem happens in the function LoadTextFile. It gives me run time error 53: file not found on this line:
Open sFile For Input As #iFile.
If I change one portion of the macro above it from this:


SubFolderFile = Dir(SubFolder1 & "\" & "hostname.*")


sPath = SubFolder1 & SubFolderFile

to this:


SubFolderFile = SubFolder1 & "\hostname.bge0"


sPath = SubFolderFile


then the function finishes out and the code works. But I need to avoid hardcoding the file extension when defining the SubFolderFile as it changes occasionally from ".bge0" to ".1ge0" or something similar. So this code:
SubFolderFile = Dir(SubFolder1 & "\" & "hostname.*") has the Dir function call out the file without specifying the extension (which works) an then this code:
sPath = SubFolder1 & SubFolderFile appears to properly reassemble the full UNC path and file name... but like I said it causes the function to not be able to find the file.

Any idea how it can be fixed? If so then I will have successfully completed steps 1 & 2 and can then focus on the more challenging step 3.

westconn1
07-21-2014, 02:17 PM
try
sPath = SubFolder1 & "\" & SubFolderFile

Sayre
07-21-2014, 03:52 PM
That worked! I should have caught that. Sometimes it helps to get another set of eyes on it, thank you westconn1!