By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
432,118 Members | 1,134 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 432,118 IT Pros & Developers. It's quick & easy.

Visual Basic - Looping through files

P: 7
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").Select
ActiveCell.FormulaR1C1 = "=RC[-10]+RC[-9]"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]"
Range("O2").Select
Selection.Copy
Range("E2").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 2).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("P2").Select
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("O2:P2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets.Add
Range("A6").Select
ActiveSheet.Paste
Range("A5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Times"
Range("B5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-3]C[1]"
Range("C5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-3]C[1]"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Site Name"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(Sheet1!RC[-1],""_"",Sheet1!RC)"
Range("A2:C5").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]=""flow"",""02"",IF(RC[-3]=""pressure"",""01"",IF(RC[-3]=""level percent"",""03"")))"
ActiveCell.Offset(2, 0).Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-5]C[-3],""_"",R[-2]C)"
ActiveCell.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E5").Delete
Range("E6").Delete
ActiveSheet.Select
ActiveSheet.Copy
Range("B2").Select
strName = Range("B2")
ActiveWorkbook.SaveAs Filename:="R:\Master\" & strName _
, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
ActiveWorkbook.Close
Jan 18 '08 #1
Share this Question
Share on Google+
3 Replies


kadghar
Expert 100+
P: 1,295
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 BuiltinDocumentProperties 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:

Expand|Select|Wrap|Line Numbers
  1. sub something()
  2. dim Obj1 as object
  3. dim Str1 as string
  4. dim myPath as string
  5. dim i as integer
  6. set obj1 = createobject("excel.application")
  7. mypath = "c:\thepath\" 'please note you should a "\" at the end.
  8. str1 = dir(mypath & "*.xls")
  9. do
  10.     obj1.workbooks.open (mypath & str1)
  11.     for i = 1 to ubound(UsersList)
  12.         if obj1.activeworkbook.builtindocumentproperties("Author").value = userslist(i) then 
  13.             call Macro1 'or do whatever you want with the file
  14.             exit for
  15.         end if
  16.     next
  17.     obj1.activeworkbook.close
  18.     str1 = dir()
  19. Loop Until Str1 = ""
  20. obj1.Visible = True
  21. obj1.Quit
  22. 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
Jan 18 '08 #2

P: 7
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
Attached Files
File Type: zip vb.zip (67.8 KB, 85 views)
Jan 18 '08 #3

kadghar
Expert 100+
P: 1,295
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.ActiveWorkbook.ActiveSheet and instead of Sheet2 uses Obj2.ActiveWorkbook.ActiveSheet. 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)

Expand|Select|Wrap|Line Numbers
  1. Dim Obj1 As Object
  2. Dim Obj2 As Object
  3. Dim UserList()
  4. Sub RunMe()
  5. Dim Str1 As String
  6. Dim myPath As String
  7. Dim i As Integer
  8. Set Obj1 = CreateObject("excel.application")
  9.  
  10. myPath = "C:\[WriteHereThePath]\" 'please note you should a "\" at the end.
  11.  
  12. Str1 = Dir(myPath & "*.xls")
  13. Set Obj2 = CreateObject("excel.application")
  14. Do
  15.     Obj1.Application.DisplayAlerts = False
  16.     Obj1.Workbooks.Open (myPath & Str1)
  17.     'For i = 1 To UBound(userslist)
  18.         'If Obj1.ActiveWorkbook.BuiltinDocumentProperties("Author").Value = userslist(i) Then
  19.              Call Macro1Bis 'or do whatever you want with the file
  20.         '    Exit For
  21.         'End If
  22.     'Next
  23.     Obj1.ActiveWorkbook.Close
  24.     Obj1.Application.DisplayAlerts = True
  25.     Str1 = Dir()
  26. Loop Until Str1 = ""
  27. Set Obj1 = Nothing
  28. Set Obj2 = Nothing
  29. End Sub
  30. Sub Macro1Bis()
  31.     'Not a recorded Macro, created by Kad
  32.     'Dont run me, as you can see RunMe will call me in time
  33.     Dim a
  34.     Dim Str1 As String
  35.     Dim Str2 As String
  36.     With Obj1.ActiveWorkbook.ActiveSheet
  37.         .Range(.Cells(2, 15), .Cells(2, 5).End(-4121).End(-4161).Offset(0, 2)).FormulaR1C1 = "=RC[-10]+RC[-9]"
  38.         .Range(.Cells(2, 15), .Cells(2, 15).End(-4121).Offset(0, 1)).FormulaR1C1 = "=RC[-7]"
  39.         a = .Range(.Cells(2, 15), .Cells(2, 16).End(-4121))
  40.     End With
  41.     Obj2.Workbooks.Add
  42.     With Obj2.ActiveWorkbook.ActiveSheet
  43.         .Range(.Cells(6, 1), .Cells(5 + UBound(a), UBound(a, 2))) = a
  44.         .Cells(5, 1) = "Times"
  45.         .Cells(5, 2) = Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 3)
  46.         Select Case UCase(.Cells(5, 2))
  47.             Case "PRESSURE": Str1 = "01"
  48.             Case "FLOW": Str1 = "02"
  49.             Case "LEVEL": Str1 = "03"
  50.         End Select
  51.         .Cells(5, 3) = Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 4)
  52.         .Cells(2, 1) = "Site Name"
  53.         .Cells(2, 2) = Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 1) & "_" & Obj1.ActiveWorkbook.ActiveSheet.Cells(2, 2) & "_" & Str1
  54.          Str2 = .Cells(2, 2)
  55.          Obj2.Application.DisplayAlerts = False
  56.          Obj2.ActiveWorkbook.SaveAs Filename:="r:\" & Str2, FileFormat:=xlCSV, CreateBackup:=False
  57.     End With
  58.     Obj2.ActiveWorkbook.Close
  59.     Obj2.Application.DisplayAlerts = True
  60. End Sub
Jan 19 '08 #4

Post your reply

Sign in to post your reply or Sign up for a free account.