Visual Basic - Looping through files

[richie9648]

Hi All

I have created a macro which turns reports done by users into a format that is needed by me. The good this is that all the reports are in the same format.

However my question is around automating this process especially when there could be potentially hundreds of files by users that need converting.

Is there a way a routine could be run automatically which opened all the files on the drive that had been created by users, format them into my format which is a CSV format?

Also I am a little stuck with creating a mastersheet so that when new data comes in I can add this to a master sheet. What happens when it goes over 64000 lines? Can I use a text file?

The code I have written so far is a little rubbish and is below - seeing the files may explain what I am trying to do but I am unable to attach any files to the post :(

any help much appreciated

Thanks

Sub Macro1()

Range("O2").Sel ect
ActiveCell.Form ulaR1C1 = "=RC[-10]+RC[-9]"
Range("P2").Sel ect
ActiveCell.Form ulaR1C1 = "=RC[-7]"
Range("O2").Sel ect
Selection.Copy
Range("E2").Sel ect
Selection.End(x lDown).Select
Selection.End(x lToRight).Selec t
ActiveCell.Offs et(0, 2).Select
Range(Selection , Selection.End(x lUp)).Select
ActiveSheet.Pas te
Range("P2").Sel ect
Application.Cut CopyMode = False
Selection.Copy
Range("E2").Sel ect
Selection.End(x lDown).Select
Selection.End(x lToRight).Selec t
Selection.End(x lToRight).Selec t
ActiveCell.Offs et(0, 1).Select
Range(Selection , Selection.End(x lUp)).Select
ActiveSheet.Pas te
Range("O2:P2"). Select
Range(Selection , Selection.End(x lDown)).Select
Selection.Copy
Application.Cut CopyMode = False
Selection.Copy
Selection.Paste Special Paste:=xlPasteV alues, Operation:=xlNo ne, SkipBlanks _
:=False, Transpose:=Fals e
Sheets.Add
Range("A6").Sel ect
ActiveSheet.Pas te
Range("A5").Sel ect
Application.Cut CopyMode = False
ActiveCell.Form ulaR1C1 = "Times"
Range("B5").Sel ect
ActiveCell.Form ulaR1C1 = "=Sheet1!R[-3]C[1]"
Range("C5").Sel ect
ActiveCell.Form ulaR1C1 = "=Sheet1!R[-3]C[1]"
Range("A2").Sel ect
ActiveCell.Form ulaR1C1 = "Site Name"
Range("B2").Sel ect
ActiveCell.Form ulaR1C1 = "=CONCATENATE(S heet1!RC[-1],""_"",Sheet1!R C)"
Range("A2:C5"). Select
Selection.Copy
Range("A2").Sel ect
Selection.Paste Special Paste:=xlPasteV alues, Operation:=xlNo ne, SkipBlanks _
:=False, Transpose:=Fals e
Application.Cut CopyMode = False
Range("E5").Sel ect
ActiveCell.Form ulaR1C1 = _
"=IF(RC[-3]=""flow"",""02" ",IF(RC[-3]=""pressure""," "01"",IF(RC[-3]=""level percent"",""03" ")))"
ActiveCell.Offs et(2, 0).Select
ActiveCell.Form ulaR1C1 = "=CONCATENA TE(R[-5]C[-3],""_"",R[-2]C)"
ActiveCell.Copy
Range("B2").Sel ect
Selection.Paste Special Paste:=xlPasteV alues, Operation:=xlNo ne, SkipBlanks _
:=False, Transpose:=Fals e
Range("E5").Del ete
Range("E6").Del ete
ActiveSheet.Sel ect
ActiveSheet.Cop y
Range("B2").Sel ect
strName = Range("B2")
ActiveWorkbook. SaveAs Filename:="R:\M aster\" & strName _
, FileFormat:=xlC SV, CreateBackup:=F alse
ActiveWorkbook. Close
ActiveWorkbook. Close

[kadghar]

Hi All
(...)

Is there a way a routine could be run automatically which opened all the files on the drive that had been created by users, format them into my format which is a CSV format? (...)

well, i dont really know how to acces the files' info via VBA, since many useful commands in VB aren't available here. I can only think of using DIR and BuiltinDocument Properties once we've located an excel file (im assuming all this files are excel files). So what im going to do is to create an excel application (as an object). Then im going to run a DIR through all the files in a path and its going to open each excel file. Once its oppened, it's going to check the Author in its properties and if its an author from a list, its going to run Macro1 with it's info (or any other sub, that can actually format them into a csv)

Now, the problem here is that Macro1 is clearly a recorded one. That won't help you, since it takes the info in sheet1 and takes it to sheet2 and do all the work with only one workbook, and worst of all, it uses copy-paste (where you aren't making reference where to copy from and where to paste to) ... but we can certainly discuss that later.

The procedure i've made checks all the files' authors in a single path, i dont think runnig it through the whole HDD would be convinent:

sub something()
dim Obj1 as object
dim Str1 as string
dim myPath as string
dim i as integer
set obj1 = createobject("excel.application")
mypath = "c:\thepath\" 'please note you should a "\" at the end.
str1 = dir(mypath & "*.xls")
do
    obj1.workbooks.open (mypath & str1)
    for i = 1 to ubound(UsersList)
        if obj1.activeworkbook.builtindocumentproperties("Author").value = userslist(i) then 
            call Macro1 'or do whatever you want with the file
            exit for
        end if
    next
    obj1.activeworkbook.close
    str1 = dir()
Loop Until Str1 = ""
obj1.Visible = True
obj1.Quit
end sub

please note im assuming (once again) that you've created an authors list called UsersList

(...)Also I am a little stuck with creating a mastersheet so that when new data comes in I can add this to a master sheet. What happens when it goes over 64000 lines? Can I use a text file? (...)

You can save it as a textfile, of course, but i'm not getting the point...

Do you want to save the excel book as a text file each time it reaches the limit and start a new one? or do you want to work all the info as a txt file instead of a workbook?

The code I have written so far is a little rubbish and is below - seeing the files may explain what I am trying to do but I am unable to attach any files to the post :(

any help much appreciated

Thanks

yes, i think the code you 'wrote' must be cleaned up a little bit (since you don't really have to close the activeworkbook twice).

To atach files, make the post, then edit it, while editing it you'll see the attaching options.

HTH

[richie9648]

Thanks HTH - I have attached the files below - yes I agree the code is shocking but I am fairly new to this so any help in cleaning would be good.

Thanks for your comments as well

Rich

[kadghar]

Thanks HTH - I have attached the files below - yes I agree the code is shocking but I am fairly new to this so any help in cleaning would be good.

Thanks for your comments as well

Rich

HTH = Hope That Helps;
Call me Kad, i like that nick.

Yes, the macro you recorded has many troubles there. The main one is that you're only refering it to the workbook itself, and if you want to use it for many workbooks, it has to change a little bit. What i recommend you is: first of all you should create a couple of objects, they're going to be Excel Applications:

Excel Application 1 (i'll call it Obj1) will have the User file with 'Original.xls' format

Excel Application 2 (or Obj2) will be the one with Sheet2, but this time im not creating another sheet in Obj1 and then exporting it into another file. Im leaving Obj1 as it is, and working with Obj2.

I will use DIR to check each file *.xls in some path (you write it), for each file, its going to:

1. open the file in Obj1
2. check if its "author" its in the list
3. if its in the list, it'll call Macro1Bis (by me, yeah)
4. close the workbook (but not the application)

** Please note Step 2 is commented in the code and will not do it, it will run Macro1Bis for each and every XLS file in the path. Later we can discus how to work with that UserList.

Macro1Bis does exactly what your macro used to do, but without Copy-Paste, and istead of Sheet1 uses Obj1.ActiveWork book.ActiveShee t and instead of Sheet2 uses Obj2.ActiveWork book.ActiveShee t. And finaly, instead of saving Obj2 as an XLS file, it saves a CSV... nice ^.^

Please note: Macro1Bis has exactly the same bug your Macro1 used to have. it uses END(xldown) and END(xlright) i dont like using excel's constants so i use -4121 instead of xldown and -4161 instead of xlright, anyway, it's the same thing. The problem is:

END(xldown) its like pressing Ctrl + DownArrow while in the excel worksheet
if you're standing in cell E2 and you only have that observation, and press Ctrl+DownArrow, it'll send you to the end of the file, to the very last row, then if you want to make an offset..oops, there're no cells left to move to. you're in the end of the worksheet.
This of course will not happen when you have at least 2 observations, since it'll move to the last one, and you'll have the range you want =)

So: THIS CODE IS USELES IF YOU HAVE ONLY ONE OBSERVATION.

well, that's all I have to say, paste it into a new module, run the RunMe sub, but before, fill the blanks in Line 10, and check that you have an unit R:\ (line 56), because i didnt and it caused me some troubles =(. (if not, just chage it to C:\, not big deal)

HTH

(oh, and thanks, i had some free time and i like spending it doing some coding)

Dim Obj1 As Object
Dim Obj2 As Object
Dim UserList()
Sub RunMe()
Dim Str1 As String
Dim myPath As String
Dim i As Integer
Set Obj1 = CreateObject("excel.application")
 
myPath = "C:\[WriteHereThePath]\" 'please note you should a "\" at the end.
 
Str1 = Dir(myPath & "*.xls")
Set Obj2 = CreateObject("excel.application")
Do
    Obj1.Application.DisplayAlerts = False
    Obj1.Workbooks.Open (myPath & Str1)
    'For i = 1 To UBound(userslist)
        'If Obj1.ActiveWorkbook.BuiltinDocumentProperties("Author").Value = userslist(i) Then
             Call Macro1Bis 'or do whatever you want with the file
        '    Exit For
        'End If
    'Next
    Obj1.ActiveWorkbook.Close
    Obj1.Application.DisplayAlerts = True
    Str1 = Dir()
Loop Until Str1 = ""
Set Obj1 = Nothing
Set Obj2 = Nothing
End Sub
Sub Macro1Bis()
    'Not a recorded Macro, created by Kad
    'Dont run me, as you can see RunMe will call me in time
    Dim a
    Dim Str1 As String
    Dim Str2 As String
    With Obj1.ActiveWorkbook.ActiveSheet
        .Range(.Cells(2, 15), .Cells(2, 5).End(-4121).End(-4161).Offset(0, 2)).FormulaR1C1 = "=RC[-10]+RC[-9]"
        .Range(.Cells(2, 15), .Cells(2, 15).End(-4121).Offset(0, 1)).FormulaR1C1 = "=RC[-7]"
        a = .Range(.Cells(2, 15), .Cells(2, 16).End(-4121))
    End With
    Obj2.Workbooks.Add
    With Obj2.ActiveWorkbook.ActiveSheet
        .Range(.Cells(6, 1), .Cells(5 + UBound(a), UBound(a, 2))) = a
        .Cells(5, 1) = "Times"
        .Cells(5, 2) = Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 3)
        Select Case UCase(.Cells(5, 2))
            Case "PRESSURE": Str1 = "01"
            Case "FLOW": Str1 = "02"
            Case "LEVEL": Str1 = "03"
        End Select
        .Cells(5, 3) = Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 4)
        .Cells(2, 1) = "Site Name"
        .Cells(2, 2) = Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 1) & "_" & Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 2) & "_" & Str1
         Str2 = .Cells(2, 2)
         Obj2.Application.DisplayAlerts = False
         Obj2.ActiveWorkbook.SaveAs Filename:="r:\" & Str2, FileFormat:=xlCSV, CreateBackup:=False
    End With
    Obj2.ActiveWorkbook.Close
    Obj2.Application.DisplayAlerts = True
End Sub