» »

Težave z macrom

Težave z macrom

DrrMrr ::

Pozdravljeni.

Rabil bi en macro, ki bi mi v outlooku 2003 vse priponke označenih emailov shranilo na sledeč način v eno datoteko, ki bo vsebovala datum(kdaj je bila priponka poslana oz. prejeta) in ime priponke z končnico. Torej bom shranjeval seznam priponk v neko datoteko, vsako v svojo vrstico. npr.:
datum - ime datoteke

3.5.2005 bla1.txt
4.6.2004 tekst.doc
.
.
.

Zanimajo me torej samo imena datotek in datum kdaj sem jih dobil oz. poslal (odvisno kaj je izbrano, sicer pa potrebujem samo za poslane). To sem sicer uspel sestaviti in sicer vse shranjujem v neki string ne znam ga pa shraniti v datoteko. Še boljša bi bilo če bi lahko vse skupaj shranil v excelovo tabelo.

Prilagam predelan macro iz interneta, ki je shranjeval vse priloge v neko mapo. Zdaj samo izpise vse priponke izbranih emailov:

'Shrani vse priloge na disk in izpise seznam le-teh
Sub ShraniPriloge()

'deklaracije
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim ImeVrstice
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

'Vprasa po mapi kamor se bo shranjevalo
myOrt = InputBox("Destinacija", "Shranjevanje priponk.", "C:")

On Error Resume Next

'obdeluje izbrana sporočila
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
j = 0

'naredi za vsa izbrana sporocila
For Each myItem In myOlSel
'poisci priloge
Set myAttachments = myItem.Attachments
'ce so potem...
If myAttachments.Count > 0 Then

'dodamo besedilo v sporocilo, kjer so priponke, ki jih bomo shranili na disk
'myItem.Body = myItem.Body & vbCrLf & _
' "Shranjene priloge:" & vbCrLf

'Izvede for stavek za vse priponke
For i = 1 To myAttachments.Count
'shranimo priponke na izbrano lokacijo
' myAttachments(i).SaveAsFile myOrt & _
' myAttachments(i).DisplayName

'dodajanje poti shranjenih priponk k sporočilom, katerih priponke so bile shranjene
' myItem.Body = myItem.Body & _
' "Datoteka: " & myOrt & _
' myAttachments(i).DisplayName & vbCrLf
ImeVrstice = ImeVrstice & myItem.SentOn & " - " & myAttachments(i).DisplayName & vbCrLf
'MsgBox ImeVrstice
j = j + 1
Next i

'Ce zelimo izbrisati priponke omogoči naslenjo while zanko
'While myAttachments.Count > 0

'remove it (use this method in Outlook XP)
'myAttachments.Remove 1

'remove it (use this method in Outlook 2000)
'myAttachments(1).Delete

'Wend

'shranimo sporočilo
myItem.Save
End If

Next


If j > 0 Then
MsgBox "Našel sem " & j & " prilog/e." & vbCrLf & ImeVrstice _
& vbCrLf & "In jih shranil v mapo" & vbCrLf & myOrt _
, vbInformation, "Končano!"
Else
End If


'sprostimo spremenljivke
Set ImeVrstice = Nothing
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub


lp in vnaprej hvala za odgovore, D.


Vredno ogleda ...

TemaSporočilaOglediZadnje sporočilo
TemaSporočilaOglediZadnje sporočilo
»

Visual Basic

Oddelek: Programiranje
313195 (2221) cekr
»

[vb.net] textarea newline

Oddelek: Programiranje
5891 (822) dolenc
»

[EXCEL] Pogojno kopiranje na drug list

Oddelek: Programiranje
61699 (1621) StratOS
»

CDONTS in javascript

Oddelek: Programiranje
91009 (921) sp4yk
»

ASP in vnosni podatki v MDB

Oddelek: Izdelava spletišč
7928 (839) swalow

Več podobnih tem