code for file exists in db or not!Really need it now (1 Viewer)

[hfs]

Hey all,

I have code working for some workers here ,who used to save excel files in a folder and my databse upload those files into database and then do the rest.I am looking for a code in vba which,on upload button matches the file in table and if the file already exists ,it should not upload again in the table and if it does not exists it should upload . I have attached my code below :

Private Sub Command0_Click()
 Dim strcPath As String
 strcPath = "O:\QA Files\QC Reporting\Pending Review\"
 Dim strcNewPath As String
 
 strcNewPath = "O:\QA Files\QC Reporting\MovedFiles\" & Format(Now, "yyyy-mm-dd h-mm-ss") _
  & " Excel Files" & "\"
  
  strDatabaseFilePath = "O:\QA Files\QC Reporting\Pending_Review_Database_Files\"
    FileExt = "*.xl*"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   ' FSO.CreateFolder (strDatabaseFilePath)
    FSO.CopyFile Source:=strcPath & FileExt, Destination:=strDatabaseFilePath
    
     
 Dim strPath As String
 Dim strNewPath As String
 Dim strFile As String
 Dim strFileList() As String
 Dim intFile As Integer
 Dim strFullPath As String
 Dim strFullNewPath As String
 Dim msgstr As String
 Dim lot As String
 Dim strSQl        As String
 Dim SQL As String
 Dim db            As DAO.Database
 Dim rs            As DAO.Recordset
 Dim ctl           As Control
 Dim varItem       As Variant
 Dim strFileBracket As String
 Dim strDate As String
 Dim strDateList() As String
 Dim intDate As Integer
 Dim strDateResult As String
 Dim InsertStrDb As String
  
' On Error GoTo ErrorHandler
 
 ' See if path constant ends in a backslash:
 If Right(strcPath, 1) = "\" Then
  strcPath = strcPath
 Else
  strcPath = strcPath & "\"
 End If
 
 '  See if new path constant ends in a backslash:
 If Right(strcNewPath, 1) = "\" Then
  strNewPath = strcNewPath
 Else
  strNewPath = strcNewPath & "\"
 End If
[COLOR=darkred] ' Loop through the Excel files in the folder
 ' (if any) and build file list:[/COLOR]
 strFile = Dir(strcPath & "*.xlsm")
   
' strDate = Dir(strcPath & "*.xlsm")
 While strFile <> ""
  intFile = intFile + 1
  ReDim Preserve strFileList(1 To intFile)
  strFileList(intFile) = strFile
For intFile = 1 To UBound(strFileList)
'Reads the substring(the Lot# from the name of the file)
intpos = InStr(1, strFile, ")")
'intDate = InStr(1, strFile, ".")
intDatePos = InStr(1, strFile, "(")
If intpos > 0 Then
' : found, so take up to :
  If strFile = "" Then
 '  MsgBox ("There is no file")
   Else
    strResult = Left(strFile, intpos)
   ' strDateResult = Left(strFile, intDate - 1)
  strLotFinalResult = Left(strResult, intpos - 1)
   ' strNewDate = Right(strFile, intDate - 1)
  ' strRight = Right(strFile, intDatePos - 8)
   strNewDate = Mid(strFile, intDatePos)
   strRight = Left([strNewDate], InStrRev([strNewDate], ".") - 1)
   strFinalDate = Right(strRight, 8)
    strDate1 = Left(strFinalDate, 2)
    strDate2 = Mid(strFinalDate, 3, 2)
    strDate3 = Right(strFinalDate, 4)
    
    InsertStrDb = (strDate1) & "/" & (strDate2) & "/" & (strDate3)
  
     ' Initialise paths:
   [COLOR=red]strFullPath[/COLOR] = strcPath & strFile

[SIZE=5][COLOR=red] 
    "Something HERE maybe for matching the file name before inserting"[/COLOR][/SIZE]
   
   Set db = CurrentDb()
   DoCmd.SetWarnings (False)
   strSQl = "INSERT INTO tblExcelLocation(LotNumber,ExcelPathLocation,SearchByDate) VALUES ( " & " (' " & strLotFinalResult & "')" & ",(' " & Replace([SIZE=4][COLOR=red]strFullPath[/COLOR][/SIZE], "'", "''") & "'),(' " & Replace(InsertStrDb, "'", "''") & " '))"
   DoCmd.RunSQL (strSQl)
   DoCmd.SetWarnings (False)
   db.Close
  End If
 
  
   Else
    ' : not found, so take whole string
    strResult = strFile
 '   MsgBox (strResult)
End If
    If strFile = "" Then
  ' MsgBox ("There is no file")
   Else
 strFile = Dir()
 End If
' MsgBox UBound(strFileList) & " file(s) were imported", _
  vbOKOnly + vbInformation, "Program Finished"
' Next
 Next
 Wend
   FileExt = "*.xl*"
   Set FSO = CreateObject("Scripting.FileSystemObject")
  
 If FSO.FileExists(strcPath) Then
        answer = MsgBox("File already exists in this location. " _
            & "Are you sure you want to continue? If you continue " _
            & "the file at destination will be deleted!", _
            vbInformation + vbYesNo)
        If answer = vbNo Then
            Exit Sub
        End If
       ' Kill strcNewPath
    End If
    'FSO.CreateFolder (strDatabaseFilePath)
    FSO.CopyFile Source:=strcPath & FileExt, Destination:=strDatabaseFilePath
  Set FSO = Nothing
  
  
'Code for deleting .xlsm files from pending review folder 'but i dont need this at the point
'del_xlsm
 ' See if any files were found:
   
  ' MsgBox (strFullPath)
  ' Import into Access:
  'DoCmd.TransferSpreadsheet acImport, _
  ' acSpreadsheetTypeExcel97, strcTableName, _
   'strFullPath, True

MsgBox " All file(s) imported ", _
  vbOKOnly + vbInformation, "Program Finished"
 
 
 
End Sub

 

[MarkK]

My 2c is that that code needs to be cleaned up before anything. Delete the commented out lines. Move all variable declarations to the top. Write sub routines for repeated operations, and so on. Bugs hide and multiply in messy code.

Where have you declared this variable?

    Set FSO = CreateObject("Scripting.FileSystemObject")

If it's not declared anywhere, you need to Require Variable Declaration. In a code windows goto MainManu-->Tools-->Options-->Editor Tab-->Code Settings Box and make sure the second option, Require Variable Declaration is checked. Then, at the top of each module, starting with the one this code is in, it should say . . .

Option Compare Database
Option Explicit

Now compile your code and resolve any errors.

But it's the same in construction and probably many industries, that sometimes the job site becomes too messy to get any work done. Like in an office, sometimes you need to stop everything and clean off your desk. Hospitals need to be sterile to function properly. Your code needs to be clean like a hospital or it will keep catching bugs.

hth