kollision mellem lægge-til-funktion og checke-funktion
Hej.I går fik jeg hjælp til at få tilføjet sådan, så hvis filnavnet findes i forvejen, så skal der lægges et tal til filnavnet. Det virker fint, men når jeg sætter det ind på denne knap, hvor man sender de data man har, går det galt. Normalt kigger den om der findes en fil med samme navn som man er ved at gemme som, i sendt mappen. Men nu lægger den, som den skal, et tal til, hvilket i dette tilfælde ikke skal ske..kan man ikke kombinere de 2, så hvis filnavn findes i forvejen, og indhold IKKE er det samme, skal der oprettes en ny fil. Evt. ref.: http://www.eksperten.dk/spm/402239
-----------------------------
Sub email_Click()
Dim sti1 As String, sti2 As String, sti3 As String, Navn As String, uge As String, mail As String
sti1 = "c:\timeregistrering\"
sti2 = sti1 & Range("init").Value
sti3 = sti2 & "\sendt\"
uge = Range("uge").Value
Navn = Range("init").Value & " " & uge
modtager = "time@muggler.dk"
If Range("navn").Value = "" Then
MsgBox "Der er ikke angivet et navn!", vbCritical
Exit Sub
End If
If Range("C9").Value = "" Then
MsgBox "Du har ikke angivet dato i det først felt!", vbCritical
Exit Sub
End If
If Dir(sti1, vbDirectory) = "" Then MkDir sti1
If Dir(sti2, vbDirectory) = "" Then MkDir sti2
If Dir(sti3, vbDirectory) = "" Then MkDir sti3
nr = ""
ii = 0
Do
Fundet = (Dir(sti3 & Navn & nr & ".txt"))
Snavn = Navn & nr & ".txt"
If Fundet <> Snavn Then ' tjekker om den eksisterer
Exit Do
End If
ii = ii + 1
nr = " - " & ii
Loop
Dim i As Long, b As Long
Dim x As Variant
Dim y As String
A = Dir(sti3 & Navn & nr & ".txt")
If A = "" Then
GoTo Forskel
Else
Open sti3 & Navn & nr & ".txt" For Input As #1
Line Input #1, y
b = b + 1
x = Split(y, Chr(9))
For i = LBound(x) To 2
If x(i) <> Cells(b + 8, 1 + (i + 1)).Text Then
GoTo Forskel
End If
Next
Close #1
MsgBox "Du kan ikke sende det samme to gange!", vbCritical, "email og luk"
Exit Sub
End If
Forskel:
Close #1
Sheets("Timer").Select
Range("B9:F38").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count) 'indsætter et nyt ark og lader programmet tælle nummeret på arket
Sheets(Sheets.Count).Select
Range("A1").Select
ActiveSheet.Paste ' indsætter det kopierede materiale fra Det originale ark
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:=sti3 & Navn & nr, FileFormat:=xlText
Sheets("Timer").Select
Sheets(Sheets.Count).Delete
If Application.MailSystem = xlNoMailSystem Then
MsgBox "Der er ingen mailklient installeret!", vbInformation, "E-mail"
Exit Sub
End If
Application.ActivateMicrosoftApp (xlMicrosoftMail)
Dim Vedhæft As String
Dim olApp As Outlook.Application
Dim olNewMail As Outlook.MailItem
Set olApp = New Outlook.Application
Set olNewMail = CreateItem(olMailItem)
Vedhæft = sti3 & "\" & Navn & nr & ".txt"
With olNewMail
.Recipients.Add modtager
.Subject = Navn & nr
.Attachments.Add Vedhæft
.Save
.Send
End With
Set olNewMail = Nothing
Set olApp = Nothing
enabletoolbars
layout2
Application.quit
End Sub
-------------------------------
