Advertisement
Guest User

Untitled

a guest
Jul 28th, 2015
207
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.16 KB | None | 0 0
  1. Private Sub CommandButton1_Click()
  2.  
  3. Dim lSecurity As Long
  4. Dim myPath As Variant
  5.  
  6. lSecurity = Application.AutomationSecurity
  7. Application.AutomationSecurity = msoAutomationSecurityLow
  8. Application.DisplayAlerts = False
  9. Application.AskToUpdateLinks = False
  10.  
  11. myPath = "F:Pathname"
  12. Call Recurse(myPath)
  13.  
  14. Application.AutomationSecurity = lSecurity
  15. Application.DisplayAlerts = True
  16. Application.AskToUpdateLinks = True
  17. End Sub
  18.  
  19.  
  20. Function Recurse(sPath As Variant) As String
  21.  
  22. Dim FSO As New FileSystemObject
  23. Dim myFolder As Folder
  24. Dim myFile As Variant
  25. Dim file As String
  26. Dim A As Workbook
  27. Dim B As Workbook
  28. Dim i As Integer
  29. Dim j As Integer
  30. Dim k As Integer
  31.  
  32. Dim count As Integer
  33.  
  34. Set myFolder = FSO.GetFolder(sPath)
  35. Set A = ThisWorkbook
  36. i = 2
  37.  
  38. For Each myFile In myFolder.Files
  39. If InStr(myFile.Name, "_2015_DOMESTIC_TB") <> 0 Then
  40. Set B = Workbooks.Open(Filename:=myFile)
  41. Call Datadump
  42. B.Close SaveChanges:=False
  43. End If
  44. i = i + 1
  45. Next
  46.  
  47. End Function
  48.  
  49. Function Datadump()
  50.  
  51. A.Cells(i, 1).Value = B.Cells(1, 4).Value
  52.  
  53. For count = 1 To 59
  54. k = 2
  55. A.Cells(i, k).Value = B.Cells(11 + count, 4).Value
  56. count = count + 1
  57. k = k + 1
  58. Next count
  59.  
  60. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement