Zdravo!
Kot vedno, bi si rada zmanjšala število klikov in s tem pridobila kakšno minuto, med katero lahko srknem kavo
Prosim za pomoč pri naslednjem izzivu:
na mejl dobivam priponke v rtf. datoteki in fotografije, večinoma v jpg. Želela bi si makro, ki bi mi avtomatsko shranil tekstovne in slikovne priponke na določeno mesto (vedno isto), poleg tega bi se morala v rtf. datoteki "prilepiti" noga z imenom in potjo datoteke, ter natisniti.
Sedaj prvi del poti naredim "peš", makro za nogo imam, natisnem pa tudi "peš". Vsa ta opravila se vedno ponavljajo, zato bi jih rada združila...
Okvirni makro za shranjevanje imam, a ga nisem še uporabila.
Sub ShraniPriponke()
' Makro: MiM
Dim strPath As String
Dim objMsg As Outlook.MailItem
Dim intNumOfAttachments As Integer
Dim objAtt As Attachment
Dim strFileName As String
strPath = "N:\Dorniz_Jozica\"
For Each objMsg In ActiveExplorer.Selection
intNumOfAttachments = objMsg.Attachments.Count
For i = 1 To intNumOfAttachments
Set objAtt = objMsg.Attachments(1)
strFileName = objAtt.DisplayName
objAtt.SaveAsFile strPath & strFileName
objMsg.Body = "<file://" & strPath & strFileName & ">" & _
Chr(13) & objMsg.Body
objAtt.Delete
Next i
objMsg.Save
Next objMsg
Set objMsg = Nothing
End Sub
Makro za nogo:
Sub Noga()
'
' Noga Makro
' Makro posnel: BetkaS, dne: 6.6.2006
'
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
NormalTemplate.AutoTextEntries("Ime datoteke in pot").Insert Where:= _
Selection.Range, RichText:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
With Selection.Font
.Name = "Arial"
.Size = 10
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Prosim za pomoč...
Hvala
Makro za shranjevanje datotek
Pozdravljeni,
sem bila odsotna, zato se oglašam šele zdaj.
Moram iskreno priznati, da nimam nobenih znanj o programiranju, imam pa voljo oz. idejo, kaj naj bi se naredilo.
Opravila, ki bi jih rada skrajšala/poenostavila, se ponavljajo, zato sem sklepala, da se tudi za to na narediti/posneti makro.
Ne znam pa začeti.
Priponke (večinoma rtf in jpg), ki jih prejemam v outlooku 03, bi se morale shranit na določeno mesto. V tekstovni datoteki se naj bi vstavila noga (ime in pot datoteke). Dokument naj bi se nato še natisnil.
Morda je pa res preveč zakomplicirano?
lp,
sem bila odsotna, zato se oglašam šele zdaj.
Moram iskreno priznati, da nimam nobenih znanj o programiranju, imam pa voljo oz. idejo, kaj naj bi se naredilo.
Opravila, ki bi jih rada skrajšala/poenostavila, se ponavljajo, zato sem sklepala, da se tudi za to na narediti/posneti makro.
Ne znam pa začeti.
Priponke (večinoma rtf in jpg), ki jih prejemam v outlooku 03, bi se morale shranit na določeno mesto. V tekstovni datoteki se naj bi vstavila noga (ime in pot datoteke). Dokument naj bi se nato še natisnil.
Morda je pa res preveč zakomplicirano?
lp,