PDA

View Full Version : Trying to only retrieve files that i do not already have



Lukeh
02-04-2017, 04:20 PM
Hello!
I currently have a loop that grabs all of the files in a specific folder (then does some processing of the file and adds the info I need to my database). I have a table (database) built that does have a column that contains the file name. how do I alter my code so that it will go into the folder and only retrieve the files that I do not already have in the database?
Any help would be greatly appreciated!!
Thanks! :)
Here is the module:



Sub AllFiles()
'
'Update DataBase Macro
'
Sheets("DataBase").Select
Rows("5:172").Select
Selection.Delete Shift:=xlUp
Range("A5").Select
Sheets("Probe Table").Select

Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "S:\High Level\Lab\Shared\Pressman Probe\2017 Fines Testing"

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.csv")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)


'Paste probe table into workbook
Range("A1:K1169").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PressMAN Probe Report.xlsm").Activate
Sheets("Probe Table").Select
Range("B3").Select
Selection.ClearComments
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Add File Name to Table

Sheets("DataBase").Select
Cells(1, 1).Value = (filename)
Set wb = Workbooks.Open(folderPath & filename)
ActiveWindow.Close

'Process Table and Add to DataBAse
Sheets("Press Table").Select
Range("k3:L49").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-12
Range("Y3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Y3:Y49").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DataBase").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Press Table").Select
Range("Z3:Z49").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DataBase").Select
Range("AW1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Sheets("Probe Table").Select
Range("Q7").Select
Selection.Copy
Sheets("DataBase").Select
Range("CV1").PasteSpecial xlPasteValues

Sheets("Press Table").Select
Range("P1").Select
Selection.Copy
Sheets("DataBase").Select
Range("CW1").PasteSpecial xlPasteValues

Sheets("Press Table").Select
Range("Y3:Z46").Select
Selection.ClearContents

Sheets("Report").Select
Range("X3").Select
Selection.Copy
Sheets("DataBase").Select
Range("CR1").PasteSpecial xlPasteValues

Sheets("Report").Select
Range("X4").Select
Selection.Copy
Sheets("DataBase").Select
Range("CS1").PasteSpecial xlPasteValues

Sheets("Report").Select
Range("X5").Select
Selection.Copy
Sheets("DataBase").Select
Range("CT1").PasteSpecial xlPasteValues

Sheets("Report").Select
Range("X6").Select
Selection.Copy
Sheets("DataBase").Select
Range("CU1").PasteSpecial xlPasteValues


Sheets("Frame Distance").Select
Range("C2").Select
Selection.Copy
Sheets("DataBase").Select
Range("CX1").PasteSpecial xlPasteValues




'Copies top line to bottom of database.
Sheets("DataBase").Select
Range("A1:CX1").Select
Selection.Copy
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial (xlPasteValuesAndNumberFormats)
Sheets("Report").Select



filename = Dir
Loop
Application.ScreenUpdating = False
End Sub

HiTechCoach
02-05-2017, 01:37 PM
I took a look at this post because this was posting in an Access related forum.

In Access this would be very easy. A simple method would be to use DCount() to see if the filename already exists in the table.

I have been writing Access VBA code for 20+ years. I am not as experienced with Excel VBAer. My first thought is to use Range.Find() to check sheet "DataBase" for the file name. If found skip it.

See:
Find value in Range, Sheet or Sheets with VBA (http://www.rondebruin.nl/win/s9/win006.htm)

Lukeh
02-05-2017, 02:20 PM
Thank you!

jolivanes
02-06-2017, 12:23 AM
This should do as required but with a whole bunch of "don't knows".
The workbook with the code in it can not be in the same folder.
None of the workbooks in the folder can be open.
The workbooks not to be copied from are in Column E of the Sheet that is open, starting at E1.
The workbook names in column E have the proper extension included in the name.
In this code, it only copies the value from Cell A1 into the next empty cell in Column Z (26)



Sub Get_Info()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
Application.ScreenUpdating = False
MyFolder = "C:\Lukeh\Test" '<---- Change as required
MyFile = Dir(MyFolder & "\" & "*")
Do While MyFile <> ""
If Range("E1:E" & Cells(Rows.Count, 5).End(xlUp).Row).Find(What:=MyFile, LookIn:=xlValues, Lookat:=xlWhole) Is Nothing Then
With Workbooks.Open(MyFolder & "\" & MyFile)
.Sheets("Sheet1").Range("A1").Copy _
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 26).End(xlUp).Offset(1)
.Close False
End With
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

jolivanes
02-07-2017, 03:04 PM
You mention that you have the names of the files previously opened in a database table.
The following is part of your code and is hard coded.

Sheets("DataBase").Select
Cells(1, 1).Value = (filename)
This never changes the range so the name of the last file opened will always be in cell A1.
Should that not be

Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = filename
This way, the files opened will be in cell A2 and down.