[es] - (excel) slanje dokumenata e-mailom (Outlook 2010)

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.

Profil

Re: (excel) slanje dokumenata e-mailom (Outlook 2010)

^{08.06.2011. u 17:36 - pre 168 meseci}

Molim još malo pažnje za slanje dokumenata

dodala sam radni list katalog u njemu su adrese i naziv dokumenta prema kojim bi trebala rasporediti dokumente iz Sheet "Files" u Sheet1 te pridružiti adrese iz kataloga.

U katalogu se nalaze adrese i primatelji (File Path ili put do dokumanta i njegov naziv) kojih ima više nego ih treba poslati jer nekada šaljem samo 50 e-mailova a nekada 350. Može se dogoditi da na jednu adresu ide 30 dokumanata, a isto tako jedan dokumenat na trideset adresa kako je napravljeno u katalogu.

Srdačan pozdrav

Prikačeni fajlovi

FindPathAllFilesInFolder1.xls - 866k

Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898

+66 Profil

Re: (excel) slanje dokumenata e-mailom (Outlook 2010)

^{09.06.2011. u 12:07 - pre 168 meseci}

Citat:

Sudarica: Molim još malo pažnje za slanje dokumenata

Postao sam u ovoj temi pa se osjećam prozvanim

Pitam se koji ti to posao radiš kada imaš takve potrebe?

Vidi nemam vremena ponovno se udubljivati u temu ali evo nekih brzinskih prijedloga jer ne znam koliko može biti opcija a vjerojatno bi se pomoću Macroa dalo fixirati

Dakle Sheet "katalog" je polazna točka u kojoj si odredila što ćeš kome slati
U stupac A postavi e-mail adrese a u stupac B FileName

PRVI NAČIN:

1. Napraviš na sheetu "katalog" tako da ti prvo bude u stupcu A e-mail pa stupac B FilesName
2. Selektiraš sve i Copy
3. Prijeđeš na Sheet1 ćelija B2 => pa Paste Special/Values
4. Sada imaš sve e-mail adrese na svom mjestu i FilesName (stupci B i C)
5. Selektiraš FilesName za jednu e-mail adresu i Transpose u D2 usporedno u istom redu
6. Sada imaš za dotičnu e-mail FilesName u istom redu a to odgovara onom Macrou koji šalje e-mailove
7. Pobrišeš duplikate e-mail adresa za koju si radila ovu radnju
8. Opet ideš dalje na Delete praznih među-redova
9. Ponoviš radnju za slijedeću e-mail adresu
10. Na kraju prije slanja obrišeš stupac C i imaš polaznu situaciju za slanje e-mailova preko Makronaredbe

Jeste da je "manualno" ali ako nema drugog načina "snađi se"

DRUGI NAČIN:

1.Upotrijebi Macro Function koja će automatski kopirati UNIQUE e-mail adrese na Sheet1 sa Sheeta "katalog"
2.Tada manualno sa Sheeta "katalog" transponiraš FileName za određenu e-mail adresu

Code:
Function UNIQUE(InputRange As Range, ItemNo As Long) As Variant
Dim cl As Range, cUnique As New Collection, cValue As Variant
    Application.Volatile
    On Error Resume Next
    For Each cl In InputRange
        If cl.Formula <> "" Then
            cUnique.Add cl.Value, CStr(cl.Value)
        End If
    Next cl
    UNIQUE = ""
    If ItemNo = 0 Then
        UNIQUE = cUnique.Count
    Else
        If ItemNo <= cUnique.Count Then
            UNIQUE = cUnique(ItemNo)
        End If
    End If
    On Error GoTo 0
End Function

formula za funkciju je:
(redom se povećava broj)
BTW: Raspon podataka na Sheetu "katalog" e-mail adresa sam imenovao nazivom "emailovi"

Code:

B2 => =UNIQUE(emailovi;1)
B3 => =UNIQUE(emailovi;2)
B4 => =UNIQUE(emailovi;3)
B5 => =UNIQUE(emailovi;4)
...

TREĆI NAČIN:

1.Upotrijebi Macro koji će nakon pokretanja kopirati UNIQUE e-mail adrese na Sheet1 sa Sheeta "katalog"
2.Tada manualno sa Sheeta "katalog" transponiraš FileName za određenu e-mail adresu

Code:
Sub KopirajUniqueText()
   For Each sh In Sheets(Array("katalog")) 'Sheet koji se pretražuje
           For Each cl In sh.Columns(1).SpecialCells(2) 'stupac koji se pretražuje 1=A
            If InStr(c01, cl.Value) = 0 Then c01 = c01 & "|" & cl.Value
        Next
    Next
    Sheets("Sheet1").Cells(2, 2).Resize(UBound(Split(c01, "|"))) = Application.Transpose(Split(Mid(c01, 2), "|")) 'Sheet na kojem želimo rezultat u (2,2) tj. B2
End Sub

Evo toliko o ovome od mene.
Vjerujem da bi se možda moglo riješiti i automatsko transponiranje ali to ti MOŽDA pomogne netko drugi

BTW: File ti je prevelik jer na Sheetu FILES imaš previše redova. Obriši redove koje ne koristiš pa će se file smanjiti (kao što su ovi moji)
U attachu (ZIP file) nalaze se svi načini koje sam ovdje opisao, pa pogledaj kako to izgleda u praksi.

Prikačeni fajlovi

CopyUniqueText.zip - 58.39k

Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.

Profil

Re: (excel) slanje dokumenata e-mailom (Outlook 2010)

^{11.06.2011. u 10:08 - pre 168 meseci}

Hvala puno na trudu radiću tako bilo bi mi puno jednostavnije kada bi i to radilo na klik ali ako nema vremena za to kaj se može i ovo je 95 posto više od onog što sam imala do sada.

Normalno ako ikada neko
poželi napisati naredbu i za ovaj zdanji korak (jednostavno upariti e-mail adrese iz kataloga s "File Path" iz Sheet (files) prema rasporedu iz kataloga kolone FileName1) bit ću presretna i zahvalna

srdačan pozdrav

Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898

+66 Profil

Re: (excel) slanje dokumenata e-mailom (Outlook 2010)

^{12.06.2011. u 17:57 - pre 168 meseci}

Citat:

Sudarica: bilo bi mi puno jednostavnije kada bi i to radilo na klik ali ako nema vremena za to kaj se može.......................(jednostavno upariti e-mail adrese iz kataloga s "File Path" iz Sheet (files) prema rasporedu iz kataloga kolone FileName1) bit ću presretna i zahvalna

Ako nemam ja ima netko drugi, a uz malo googlanja sve se nađe ;)
Evo macro koji kopira Unique e-mail adrese u jedan stupac i pridružuje transponirane pripadajuće FilesName

Code:
Option Explicit
Sub CopyUniqueTranspose()

  Dim Cell As Range
  Dim Data As Variant
  Dim Dict As Object
  Dim DstRng As Range
  Dim Key As Variant
  Dim Item As Variant
  Dim R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet

    Set Wks = Worksheets("katalog")
    Set Rng = Wks.Range("A1")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))

    Set DstRng = Worksheets("Sheet1").Range("B2")

    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = vbTextCompare

      For Each Cell In Rng
        Key = Trim(Cell)
        Item = Array(Cell.Item(1, 2))
          If Not Dict.Exists(Key) Then
             Dict.Add Key, Join(Item, "|")
          Else
             Dict(Key) = Dict(Key) & "|" & Join(Item, "|")
          End If
      Next Cell

      For Each Key In Dict.Keys
        With DstRng.Offset(R, 0)
          .Value = Key
          Data = Split(Dict(Key), "|")
          .Offset(0, 1).Resize(1, UBound(Data) + 1).Value = Data
          R = R + 1
        End With
      Next Key
End Sub

Prikačeni fajlovi

CopyUniqueEmailTransposeData.xls - 70k

Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.

Profil

Re: (excel) slanje dokumenata e-mailom (Outlook 2010)

^{16.06.2011. u 18:25 - pre 168 meseci}

Hvala Ivek

mislim da je ovo fantastična naredba

ali ima jedan veliki ALI. U katalogu su sve moguće datoteke i pripadajuće adrese ali u Sheetu "Files" se nalaze samo one koje moram poslati. Dali se njih može kopirati uz odgovarajuću e-mail adresu i pripremiti za slanje.

U svakom slučaju velika hvala

Srdačan pozdrav

Prikačeni fajlovi

UniqueEmailTransposeData1.xls - 60k

Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898

+66 Profil

Re: (excel) slanje dokumenata e-mailom (Outlook 2010)

^{17.06.2011. u 09:19 - pre 168 meseci}

Citat:

Sudarica: Dali se njih može kopirati uz odgovarajuću e-mail adresu i pripremiti za slanje.

Kako će Excel znati koji FilesName pripadaju kojoj e-mail osim ako ti to ne definiraš nekako?
Stalno ima neki "ALI"

Teško je sada na kraju to ovako kada nisi odmah opisala organizaciju podataka a ni sada je ne kužim potpuno., osim da se neko "debelo" uhvati programiranja, a možda ima i drugi način

Napravi kopiju Sheeta "katalog" i kopiju imenuj nazivom "katalog-2". Ove radnje uvijek radiš na kopiji Sheeta "katalog"
Izdvoji na Sheetu "katalog-2" duplikate preko formule pa obriši višak stupaca i redova koji ti ne treba, pa sa njega povuci sve i transponiraj na Sheet1

Koliko sada shvaćam (ako dobro shvaćam) ti imaš unaprijed definirane e-mail adrese i pripadajuće files (paritete) i u principu znaš kojoj osobi koje files šalješ. Stvar je samo u datom trenutku koje files imaš u folderu??
Ja još jedino mogu pomoći na ovaj način (neka poluautomatizacija u nekoliko klikova)

1. Postavi ovu formulu u "C" stupac na Sheetu "katalog-2". (sheet "Katalog-2" tj. kopiju uvijek praviš iznova prije slanja e-maila)

Code:
=IF(ISERROR(MATCH(B1;FILES!$A$5:$A$200;0));"";B1)

kopiraj je prema dolje do zadnjeg reda.
Sada imaš duplikate tj. sve FilesName (sa Sheeta "FILES") koje trebaš poslati a ujedno su paritetni dotičnim e-mail adresama.

2. Sada imaš višak stupac "B" u kojem se nalaze svi FilesName, ovaj stupac bi trebalo obrisati no problem je što su rezultat formule a da bi sveli podatke na čistu vrijednost-text idi na ,
- Select trenutni stupac "C" => Copy => Paste Special u stupac "D" => Value
- ili pokretanjem Macroa "CopyCuD" kopiraj podatke iz C u D stupac

3. Obriši sada trenutne stupac "B" i "C" pa potom klik na button za pokretanje makronaredbe "deleteRow" da ti obriše prazne redove u u "B" stupcu (koji sada sadržava FilesName samo iz Sheeta FILES)
4. Sada si spremna za kopiranje i transponiranje na sheet1

Naravno dobro provjeri kako si prepravila makronaredbe i nazive sheets

Napomena: Ako makronaredbe pokrećeš preko buttona tada buttone postavi nekoliko redova ispod svih podataka na Sheetu "katalog-2" jer u protivnom će se obrisati kada budeš brisala redove (ili makronaredbe pokreći preko ALT+F8 )

Makronaredba u Module4 za kopiranje iz stupca "C" u stupac "D"

Code:
Sub CopyCuD()
With Sheets("katalog-2") 'izvorni Sheet
.Range(.Range("C1"), .Range("C65536").End(xlUp)).Copy 'izvorni stupac
End With
'destinacijski Sheet (u ovom slučaju je isti kao i izvorni)
Sheets("katalog-2").[D65536].End(xlUp)(1).PasteSpecial Paste:=xlValues 'prva ćelija u koju se kopira a to je D1
End Sub

Makronaredba u Module4 za brisanje praznih redova u stupcu "B"

Code:
Sub deleteRow()
ColumntoDelete = "B"
For i = Cells(Rows.Count, ColumntoDelete).End(xlUp).Row To 1 Step -1
If Cells(i, ColumntoDelete) = "" Then Cells(i, "B").EntireRow.Delete
Next i
End Sub

Grubi sažetak:
1. Očitaj folder za FilesName
2. Kopiraj podatke iz C u D
3. Obriši stupce B i C
4. Obriši prazne redove u sadašnjem stupcu B
5. Na Sheetu1 pokreni Macro za kopiranje i transponiranje sa Sheeta katalog-2
6 pošalji e-mailove

btw: pogledaj attach i prepravljenu makronaredbu u Module3 kao i nove makronaredbe u Module4

Prikačeni fajlovi

UniqueEmailTransposeData2.xls - 92k

Odgovor na temu