Function

Hi,

i have a problem using a function to find a file.

in the "Sub Main" i want to use my funktion "findfile" twice to 2 files.

i got :

[
sub main()

test = findfile ("C:\", test.txt)
test2 = findfile ("C:\", test.pdf)

end sub
]

test will recieve a value.
test2 doesn't.

It seems that the function doesn't work the second time (test2 = finfile...)

Does anyone know why and how do i get the function work twice in the sub main()

thanx alot

akim123

How is the FindFile function defined? I would expect that you should be passing the second argument of the FindFile function as a string.

test = FindFile("C:\", "test.txt")
test2 = FindFile("C:\", "test.pdf")

But maybe the exclusion of the double-quotes in your snippet is just a mis-type.

Where are you getting this 'findfile' func form? Did you write it? ...if so, then could you post the code for it

hi b_mirlen,

This is slightly different to what you are after but I'm sure you could manipulate it to do what you want. It checks a folder (name defined in string variable) for files with certain modified date / times. Hope its useful !

' This function will check the date time stamp in the designated folders on finsysf and findevd.
' It then returns a string holding a message which will list any files not within pre-determined
' date/time limits.
Public Function CheckDumps() As String

Dim fso As New FileSystemObject
Dim fil As File
Dim fol As Folder
'Dim blnChkDumpsError As Boolean
'NB decided against using a bln to hold whether error has occurred or not.
'Reason for this is when doing checks on many different files if all of them have errors
'except the last one, then the bln will be true all the way to the end of the checks and then
'could be false for the last one, leaving it set to false for when the messages are written.
'Instead I will use a simple counter and 1 to it for every error. At the end of the checks
'if the counter value is greater than 1 then write errors else write no errors !
Dim intErrCount As Integer
Dim blnItsMonday As Boolean
Dim dtmDay As String

'set string to blank in case start checks is clicked more than once
CheckDumps = ""
intErrCount = 0

'what day is it when application is running
dtmDay = Format(Now, "dddd")

Select Case UCase(dtmDay)
'If its monday then the date checks are not for current date but for two days ago.
Case "MONDAY"
blnItsMonday = True
'every other day check dates = today
Case Else
blnItsMonday = False
End Select

'create object to search folder
Set fol = fso.GetFolder(strFolderToCheck)

For Each fil In fol.Files
If blnItsMonday = True Then
'if today = monday, look for saturdays date on file
If Format(fil.DateLastModified, "dd:mm:yy") <> Format(Now - 2, "dd:mm:yy") Then
'blnChkDumpsError = True
intErrCount = intErrCount + 1
strErrFileList = strErrFileList & "'" & fil.Name & "', "
Else
If Not Format(fil.DateLastModified, "hh:mm:ss") <= "04:00:00" And _
Format(fil.DateLastModified, "hh:mm:ss") >= "02:00:00" Then
'blnChkDumpsError = True
intErrCount = intErrCount + 1
strErrFileList = strErrFileList & "'" & fil.Name & "', "
Else
'blnChkDumpsError = False
'no error
End If
End If
Else
'If not monday, look for todays date on file
If Format(fil.DateLastModified, "dd:mm:yy") <> Format(Now, "dd:mm:yy") Then
'blnChkDumpsError = True
intErrCount = intErrCount + 1
strErrFileList = strErrFileList & "'" & fil.Name & "', "
Else
If Not Format(fil.DateLastModified, "hh:mm:ss") <= "04:00:00" And _
Format(fil.DateLastModified, "hh:mm:ss") >= "02:00:00" Then
'blnChkDumpsError = True
intErrCount = intErrCount + 1
strErrFileList = strErrFileList & "'" & fil.Name & "', "
Else
'blnChkDumpsError = False
'no error
End If
End If
End If
Next


If intErrCount = 0 Then
CheckDumps = "No errors in " & UCase(strFolderToCheck) & vbCrLf
Else
CheckDumps = "Errors found in " & UCase(strFolderToCheck) & ". Press View details for details." & vbCrLf
'populate Output string for print file.
strOutputError = strOutputError & vbCrLf & "FILES FAILED CHECKS IN FOLDER " & UCase(strFolderToCheck) & " AS FOLLOWS: " & vbNewLine
strOutputDetails = strOutputDetails & vbCrLf & "FILES FAILED CHECKS IN FOLDER " & UCase(strFolderToCheck) & " AS FOLLOWS: " & vbNewLine
strOutputError = strOutputError & strErrFileList & vbNewLine
strOutputDetails = strOutputDetails & strErrFileList & vbNewLine
End If

'clear strerrfilelist for next entry into this module
strErrFileList = ""

Set fil = Nothing
Set fol = Nothing
Set fso = Nothing


End Function

;)

Imports Scripting
Imports Scripting.IOMode
Imports System.IO

Module ParzellerJanuary


Dim fso = CreateObject("Scripting.FileSystemObject")

Dim fsoFolder As Scripting.Folder
Dim fsoFile As Scripting.File

Dim objExOut As New Excel.Application()
Dim objSheet As New Excel.Worksheet()
Dim objWb As Excel.Workbook
Dim ExcArray(2000) As String
Dim ExcObj As Object
Dim ExcRange As Excel.Range

Dim file As System.IO.File
Dim nurFileName As Object
Dim strDateiname = "C:\temp1\log.txt"

'Fehlermeldungen
Dim pdfMeldung1 = "[ERROR]: PDF-Datei mit Dateiname nicht gefunden"
Dim pdfMeldung2 = " ist nicht auf MM-Volume vorhanden "
Dim txtMeldung1 = "[ERROR]: EPS-Datei mit Dateiname nicht gefunden"
Private m_sFoundFilePath As String ' holds the path to the file if it is found
Private m_bFound As Boolean ' set to True if the file is found
Private m_sFoundFilePath2 As String ' holds the path to the file if it is found
Private m_bFound2 As Boolean ' set to True if the file is found
Dim j As Integer
Dim i As Integer
Dim epsDate
Dim pdfDate
Dim qx5Date
Dim qxdDate
Dim fh10Date
Dim objTextStream
Dim LastCell
Dim pdf
Dim txt
Dim test As String
Dim test1
Dim test3
Dim test2
Dim test5 As Integer

Sub Main()
objTextStream = fso.OpenTextFile(strDateiname, ForAppending, True)

objExOut.Workbooks.Open("C:\temp1\1.xls")
objExOut.Visible = False


LastCell = objExOut.Range("A65000").End(Excel.XlDirection.xlUp).Row

For j = 0 To LastCell - 1
ExcArray(j) = objExOut.Sheets(1).Cells(j + 1, 1).Value
Next


For i = 0 To LastCell - 1

' Schau nach ob es eine File mit .pdf gibt

txt = FindFile("C:\Upload\", ExcArray(i) + ".txt")
pdf = FindFile("C:\Upload\", ExcArray(i) + ".pdf")


If pdf.Equals("") Then

objTextStream.WriteLine(pdfMeldung1)
Else
If txt.Equals("") Then
objTextStream.WriteLine(txtMeldung1)


Else


pdfDate = file.GetLastWriteTime(pdf)
txtDate = file.GetLastWriteTime(txt)

If DateTime.Compare(txtDate, pdfDate) > 0 Then

msgbox("nein")

objTextStream.WriteLine(otherMeldung1)
'objTextStream.Close()
'objTextStream = Nothing

Else
test = txt

test1 = test.Length

test2 = test.LastIndexOf("\")
test5 = test1 - test2


test3 = Microsoft.VisualBasic.Right(test, test5 - 1)
If file.Exists("C:\temp1\" + test3) Then
objTextStream.WriteLine("[ERROR]: Die Datei: " + test3 + " " + "wurde schon kopiert")


Else
objTextStream.WriteLine(okMeldung1 + test3.ToString + " " + okMeldung2)
'objTextStream.Close()

file.Copy(test, "C:\temp1\" + test3)

End If


End If

End If


End If
End If

Next
objTextStream.Close()
objExOut.Workbooks.Close()
objExOut.Workbooks.Application.Quit()
objExOut.Quit()
End Sub





Public Function FindFile(ByVal sStartFolder As String, ByVal sFName As String) As String
' this is where we start. The parameters are:
' sStartFolder = the initial folder where the search will start (c:\windows in this example)
' sFName = the file to search for (e.g. ‘afile.txt’ in this example)

' create a folder object
Dim fsoFolder As Scripting.Folder

sFName = UCase(sFName)
m_sFoundFilePath = ""

' check that the start folder exists

If fso.FolderExists(sStartFolder) = True Then
' get a folder object for the top-level folder
fsoFolder = fso.GetFolder(sStartFolder)

' now check the start folder and each sub-folder in the start folder
CheckFolder(fsoFolder, sFName)
' return the path of the file, or a null string if it could not be found
FindFile = m_sFoundFilePath


End If

End Function

Private Sub CheckFiles(ByVal colFiles As Scripting.Files, ByVal sFName As String)
' this routine checks each file in a folder to see if it matches the one we're looking for
' parameters:
' colFiles = a Files collection of a Folder object
' sFName = the file we are searching for

' create a file object
Dim fsoFile As Scripting.File

' check the name of each file, and see if we have a match
For Each fsoFile In colFiles

If UCase(fsoFile.Name) = sFName Then

' we found the file, so set the module-level variable to give the file's path
' and set the flag so we don't search any more folders
m_sFoundFilePath = fsoFile.Path
m_bFound = True
Exit For
End If
Next fsoFile
End Sub

Private Sub CheckFolder(ByVal fsoFolder As Scripting.Folder, ByVal sFName As String)
Dim colFiles As Scripting.Files
Dim colFolders As Scripting.Folders
Dim fsoNextFolder As Scripting.Folder

' get the files collection in this folder and then see if we can find the file we want
colFiles = fsoFolder.Files
CheckFiles(colFiles, sFName)

' if we didn't find it, check the folder’s subfolders
If m_bFound = False Then
' get the collection of all subfolders in this folder
colFolders = fsoFolder.SubFolders
' recursively check each sub folder and all its subfolders
For Each fsoNextFolder In colFolders

CheckFolder(fsoNextFolder, sFName)
' exit if we found the file
If m_bFound = True Then Exit For
Next fsoNextFolder
End If

End Sub



End Module