Hallå!
Det är första gången jag skriver här och hoppas på eran mästerliga hjälp, hoppas också att det är i rätt forumdel ;) Det är så att jag har lyckats knåpa ihop ett outlook makro, lite stulet, lite eget, som jag använder dagligen i mitt arbete. jag har dock stött på patrull med det och söker härmed experthjälp. Koden som kommer att följa saknar lite kod som gör att filerna den skall kopiera skrivs över istället för att fylla på till den mapp jag har bestämt. ni förstår om ni läser koden. Alltså när jag kör makrot i outlook så skall det kopieras bifogade filer från dom inkomna mailen till en speciell mapp på en server. Vissa dagar så får jag bara ett mail och då är detta inget problem, men vissa dagar så får jag fler än ett mail och när jag då kör makrot så skriver den över dom bifogade filerna varteftersom makrot körs. Inge bra! jag vill alltså att makrot/koden skall skapa unika namn för filerna automatiskt. Förstår ni vad jag frågar efter?

Om ni har svaret så skriv gärna koden så som den skall vara då jag själv är väldigt rutten på att få ihop det. Please! ;)

Koden då:
Public Function SaveAttachments(Optional PathName As String, Optional FolderName As String) _
As Boolean
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
Dim oInboxFldr As Outlook.MAPIFolder
Dim oMessage As Object
Dim sPathName As String
Dim sMBoxName As String
Dim sFolderName As String
Dim oAttachment As Outlook.Attachment
Dim iCtr As Integer
Dim iAttachCnt As Integer

On Error GoTo ErrHandler

If PathName = "" Then
sPathName = "C:\Temp\"
Else
sPathName = PathName
End If

If FolderName = "" Then
sFolderName = "Inkorgen"
Else
sFolderName = FolderName
End If

If Right(sPathName, 1) <> "\" Then sPathName = sPathName & "\"
If Dir(sPathName, vbDirectory) = "" Then Exit Function

Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oInboxFldr = oNs.GetDefaultFolder(olFolderInbox)
Set oFldr = oInboxFldr.Folders(sFolderName)

For Each oMessage In oFldr.Items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For iCtr = 1 To iAttachCnt
.Item(iCtr).SaveAsFile sPathName _
& .Item(iCtr).FileName
Next iCtr
End If
End With
DoEvents
oMessage.Delete

Next oMessage
SaveAttachments = True

ErrHandler:
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Function


Sub whateverAttachment()
Dim Result As Boolean
Result = SaveAttachments("\\servernamn\mappnamn\", "whatever")
End Sub

Tacksam för hjälp med detta!
/Peter

Koden är väl kanske inte den vackraste, så det är lite knepigt att förstå hur anropen går till.

Den kod du använder som berörs är väl denna:

.Item(iCtr).SaveAsFile sPathName & .Item(iCtr).FileName

Eftersom jag inte riktigt vet hur outlook fungerar så är det svårt, men något av de här alternativen borde fungera:

1. Lägg till meddelandetiteln/avsändaren/etc. före (eller efter) filnamnet, typ

.Item(iCtr).SaveAsFile oMessage.Title & sPathName & .Item(iCtr).FileName

eller

oMessage.Sender

eller något i den stilen.

2. Ha indexnummer på filerna. Detta är krångligt eftersom du måste hålla reda på alla filnamn.

3. Skapa en mapp per avsändare. Om någon avsändare skickar mer än en fil med samma namn blir det iofs problem, men det är samma sak som i alternativ 1.

typ
MkDir sPathName & oMessage.Sender
.Item(iCtr).SaveAsFile sPathName & oMessage.Sender & "\" & .Item(iCtr).FileName


4. Ställ en fråga för varje fil som skall skrivas över. Problemet med detta är att det inte finns någon inbyggd metod i VBA för att se om filerna redan finns. Du får i så fall använda dig av FSO, men där vet jag inte vad metoden heter.

/Niklas Jansson

Ok!
Sorry för den otydliga koden :) Sen har jag nu förstått att det här är VB for applications och förmodligen inget speciellt för just outlook, eller har jag fel?!?
Hursomhelst!
Skall försöka förtydliga lite. Det är alltid samma avsändare! Filerna som är bifogade heter alltid typ 20021227.txt (datum alltså!). Jag får alltid bara en (1) bifogad fil per mail, vilket betyder om jag får två eller fler mail per dag så heter filerna samma sak fast i olika mail. Första brevet 20021227.txt andra brevet 20021227.txt osv. varför filerna naturligtvis skrivs över då det är samma filnamn på dom o detta skiter ju narurligtvis outlook högaktningsfullt i i sitt makro o bara skriver över. Detta med filnamnen kan jag inte ändra på då det sker per automatik från företaget jag får dom ifrån. Jag kan heller inte ha flera mappar att lägga dom i då jag i nästa steg kör en batch från vårat datasystem som också automatiskt scannar igenom den förutbestämda mappen efter filer. Det som däremot inte har någonsomhelst betydelse är vad filerna heter då dom hamnar i slutmappen, varför någon form av automatiskt omdöpning av filerna inte skulle spela ngn roll, snarare tvärt om.
Finns det ingen funktion för att t ex alltid ge en fil ett unikt namn eller nån autoincrement av ngt slag? Typ 20021227_xx.txt! eller vadsomhelst1.txt, vadsomhelst2.txt osv...

Hoppas att du/ni förstod vad jag menade?!

Och skriv gärna exakt var koden skall in eller liknande då jag, som jag skrev tidigare, är helrutten på detta. Det är mer eller mindre tur bara att jag har fått det att fungera så här långt :)
/Peter

>Sorry för den otydliga koden :)
Det är ingen fara, såå otydlig var den inte, det är bara det att om man inte sysslat med VBA för outlook och ser ett litet hopkok så är det lite knepigt... :)


Förklaringen var bra. Det skall nog inte vara speciellt svårt alls...

Dim iCount As Long


For Each oMessage In oFldr.Items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For iCtr = 1 To iAttachCnt
.Item(iCtr).SaveAsFile sPathName _
& CStr(iCount) & "_" & .Item(iCtr).FileName
iCount = iCount + 1
Next iCtr
End If
End With
DoEvents
oMessage.Delete


Det bör nog fungera.

/Niklas Jansson

Ah! Lysande...
Eh! Exakt vart skall detta in då? *skäms*

Public Function SaveAttachments(Optional PathName As String, Optional FolderName As String) _
As Boolean
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
Dim oInboxFldr As Outlook.MAPIFolder
Dim oMessage As Object
Dim sPathName As String
Dim sMBoxName As String
Dim sFolderName As String
Dim oAttachment As Outlook.Attachment
Dim iCtr As Integer
Dim iAttachCnt As Integer

On Error GoTo ErrHandler

If PathName = "" Then
sPathName = "C:\Temp\"
Else
sPathName = PathName
End If

If FolderName = "" Then
sFolderName = "Inkorgen"
Else
sFolderName = FolderName
End If

If Right(sPathName, 1) <> "\" Then sPathName = sPathName & "\"
If Dir(sPathName, vbDirectory) = "" Then Exit Function

Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oInboxFldr = oNs.GetDefaultFolder(olFolderInbox)
Set oFldr = oInboxFldr.Folders(sFolderName)
Dim iCount As Long


For Each oMessage In oFldr.Items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For iCtr = 1 To iAttachCnt
.Item(iCtr).SaveAsFile sPathName _
& CStr(iCount) & "_" & .Item(iCtr).FileName
iCount = iCount + 1
Next iCtr
End If
End With
DoEvents
oMessage.Delete


Next oMessage
SaveAttachments = True

ErrHandler:
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Function

Ah! Fy sjutton va bra, skall prova så fort jag kan...
En fråga till bara! Skall inte detta vara med längre i slutet som jag hade i den första koden? Sökvägen till servermappen alltså?

Sub whateverAttachment()
Dim Result As Boolean
Result = SaveAttachments("\\servernamn\mappnamn\", "whatever")
End Sub

jorå... jag tänkte bara visa var det skall sitta...

Suveränt!
Ser vart du har gjort ändringen men förstår inte vad du har gjort, men det är säkert alla tiders :)
Skall prova detta på måndag då jag är tillbaka på jobbet.
Jag hör av mig! Tack för hjälpen så långt!
/Peter

Äsch! det funkade inte :(
Har nu provat och det enda den gör nu är att lägga till 0_ framför filen, den stegar inte upp vid fler filer med samma namn! Den bara ersätter precis som förut.
Annars så är idén helt rätt, alltså 0_datumosv.txt, 1_datumosv.txt,... men den kommer alltså inte dit.
/Peter

testa med
Static iCount As Long
istället

skulle kunna funka

/Niklas Jansson

Holy dogshit private! Där hade vi det :)
Det funkar nu! F*n va jag blir glad!
tack tack tack!!!
Det här underlättar en hel del i mitt arbete. Jag är dig evigt tacksam!
/Peter