Hej Hej det finns en funktion där som heter CheckLST - den koden behöver du nog också för att kunna köra. Hej Pelle Hej, inte helt lätt här :)"With Application.FileSearch" problem
Jag har en vba kod som inte fungerar i excel 2007 eller 2010
Function FillStat(iRow, sWorkBook, sWoorkSheet, sPath)
Dim sFileName As String
Dim iStartPos As Integer
Dim iNumberOfCustLog As Integer
Dim iNumberOfCustNew As Integer
Dim sFileAborted As Boolean
sFileAborted = False
With Workbooks(sWorkBook).Worksheets(sWoorkSheet)
Do
sFileName = .Cells(iRow, 5)
'Action if K-cell is emty
If .Cells(iRow, 11) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = sPath
.filename = sFileName
sFileName = sFileName & ".log"
sFileName = sPath & "\" & sFileName
If .Execute > 0 Then
'MsgBox ("Fil funnen")
Open sFileName For Input As #1
Do
Line Input #1, temp
If Left(temp, 18) = "Processing aborted" Then
ActiveSheet.Cells(iRow, 6) = "File Processing aborted"
sFileAborted = True
Exit Do
End If
'Set the number of customers
If Left(temp, 15) = "Number of Input" Then
iStartPos = InStrRev(temp, " ")
ActiveSheet.Cells(iRow, 9) = Mid(temp, iStartPos)
iNumberOfCustLog = Mid(temp, iStartPos)
End If
'Set the number of error
If Left(temp, 15) = "Number of Error" Then
iStartPos = InStrRev(temp, " ")
ActiveSheet.Cells(iRow, 12) = Mid(temp, iStartPos)
End If
'Set the number of NEW policies
If Left(temp, 5) = " NEW" Then
iStartPos = InStrRev(temp, " ")
ActiveSheet.Cells(iRow, 11) = Mid(temp, iStartPos)
iNumberOfCustNew = Mid(temp, iStartPos)
End If
Loop Until EOF(1)
Close #1
Dim sFileNameLST As String
sFileNameLST = Left(sFileName, Len(sFileName) - 4)
'sFileNameLST = sFileNameLST & ".lst"
sFileNameLST = sFileNameLST & ".conv" & ".lst"
'Paint the cells for the ones where NEW policies differs compare to number of policies
If iNumberOfCustLog <> iNumberOfCustNew Then
ActiveSheet.Cells(iRow, 12).Interior.ColorIndex = 3
If ActiveSheet.Cells(iRow, 11) <> "" Then
Call CheckLST(sFileNameLST, iNumberOfCustNew, iRow)
End If
End If
'Dim sFileNameLST As String
If Not sFileAborted = True Then
sFileName = ActiveSheet.Cells(iRow, 5)
'If Not Checkro1file(sPath, sFileName) = True Then
If iNumberOfCustLog = iNumberOfCustNew Then
'sFileNameLST = Left(sFileName, Len(sFileName) - 4)
'sFileNameLST = sFileNameLST & ".lst"
'Call function to check so that list files are the same numbers as NEW policies
Call CheckLST(sFileNameLST, iNumberOfCustNew, iRow)
End If
' End If
End If
Else
MsgBox ("Följande fil saknas:" & vbCr & sFileName)
End If ' END IF for chek if file excist
End With ' END WITH for Application Filesearch
End If 'END IF for acton on K-cell
iRow = iRow + 1
Loop Until .Cells(iRow, 5) = ""
End With 'END WITH for Workbooks
'End If ' END IF for countrycheck
----------------------------------------------
Vad behöver jag byta i den för att det ska fungera?
Jag har "ärvt" det här macrot så jag har inte programmerat det själv och vet inte riktigt hur man gör men hoppas att ni kan hjälpa mig :)
Sv: 'With Application.FileSearch' problem
Sv:'With Application.FileSearch' problem
Nu är jag totalt nybörjare när det gäller koder så jag vet inte alls hur jag ska göra.
Har du möjlighet och lust att visa exakt vad jag ska byta för att få det att fungera?Sv: 'With Application.FileSearch' problem
Får du något felmeddelande och i så fall vad? Det kan finnas många alternativ till fel här eftersom programmet letar efter andra filer som kanske ligger på fel plats, kanske med fel namn osv. Likaså funktioner som du har ovan kallar på en annan funktion som du inte har med - den som du ser nedan, checkLST - som verkar kontrollera alla filer om de har rätt format kanske? Med den koden du har och visar här finns det lite för många alternativ till felkällor att hjälpa dig framåt - eftersom jag inte heller kan testköra denna rutin då jag behöver excelfil och de bifogade filerna som skall användas.
If iNumberOfCustLog = iNumberOfCustNew Then
'sFileNameLST = Left(sFileName, Len(sFileName) - 4)
'sFileNameLST = sFileNameLST & ".lst"
'Call function to check so that list files are the same numbers as NEW policies
Call CheckLST(sFileNameLST, iNumberOfCustNew, iRow)
End If
' End If
End If