Forum » Programiranje » 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.
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 ...
Tema | Ogledi | Zadnje sporočilo | |
---|---|---|---|
Tema | Ogledi | Zadnje sporočilo | |
» | Visual BasicOddelek: Programiranje | 3431 (2457) | cekr |
» | [vb.net] textarea newlineOddelek: Programiranje | 955 (886) | dolenc |
» | [EXCEL] Pogojno kopiranje na drug listOddelek: Programiranje | 1777 (1699) | StratOS |
» | CDONTS in javascriptOddelek: Programiranje | 1062 (974) | sp4yk |
» | ASP in vnosni podatki v MDBOddelek: Izdelava spletišč | 997 (908) | swalow |