Probleem met joker

[goof2808]

Hi,

Ik gebruik onderstaande code om klanten maximaal 5 bijlagen te mailen.

De paden naar de bijlagen staat in cel R1 t/m V1
Ik moet een joker gebruiken omdat de bijlagen elke extensie kunnen zijn

De paden die ik nu gebruik:
G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH PP\1b. AutoInvoerInsite\SlaHierBestandMailOp\3059380_1.???
....
....
....
G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH PP\1b. AutoInvoerInsite\SlaHierBestandMailOp\3059380_5.???

Maar als ik de macro start krijg ik onderstaande melding:
"De bestands- of mapnaam is ongeldig"

Kan iemand helpen alsjeblieft?

Thanks goof

Sub Send_FilesGEA()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("mail")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("F").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("R1:V1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = "info@mail.nl"
                .Subject = "" & cell.Offset(0, 17).Value
                .Body = "" & cell.Offset(0, 19).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Display  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[edmoor]

Dat werkt hier gewoon dus je moet even controleren wat Dir(FileCell.Value) terug geeft.

 

[goof2808]

In de fout opsporing wordt onderstaande code gemarkeerd:

.Attachments.Add FileCell.Value

In de betereffende map waar de bijlagen staan bevinden zich 3 bestanden:
3059380_1.xls
3059380_2.jpg
3059380_3.pdf

Gebruik ik wel een goede joker? "???"
Als ik boven Dir(FileCell.Value) hover met de cursor zie ik FileCell.Value = "G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH ....
Meer kan ik niet zien

 

[edmoor]

Je kan daar ook even MsgBox FileCell.Value doen om de hele waarde te zien.

 

[goof2808]

Ik heb in de range R1 t/m V1 de map aangepast naar

H:\test\3059380_1.???
H:\test\3059380_2.???
H:\test\3059380_3.???
H:\test\3059380_4.???
H:\test\3059380_5.???

Kan ik hem ook zien ;-)

Als ik dan boven Dir(FileCell.Value) hover dan zie ik FileCell.Value = "H:\test\3059380_1.???"

 

[edmoor]

Dat klopt natuurlijk omdat je de celwaarde bekijkt en niet het resultaat van de Dir functie.
Dat is ook wat je fout doet in je mail routine.
Niet eerder gezien

Maak er dus eens dit van:

If Dir(FileCell.Value) <> "" Then
    .Attachments.Add Dir(FileCell.Value)
End If

 

[goof2808]

Krijg nu de foutmelding: Kan dit bestand niet vinden. Controleer of het pad en de bestandsnaam juist zijn.

In de fout opsporing wordt onderstaande code gemarkeerd:

.Attachments.Add Dir(FileCell.Value)

Ik heb van de oude code

If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value

vervangen door jouw code

 

[edmoor]

Maar je laat nog steeds niet het resultaat van de Dir opdracht zien.

 

[goof2808]

3059Je bedoelt wat ie laat zien als ik boven Dir(FileCell.Value) hover?

Daar staat: "FileCell.Value = "H:\test\30593810_1.???"

 

[edmoor]

Ja, dat is de inhoud van de cel. Niet het resultaat van de Dir functie en dat is waar het om gaat.

 

[goof2808]

Hoe achterhaal ik die...?
In het venster lokale variabelen?

 

[edmoor]

Daarom zei ik eerder, doe eens dit op dat punt: Msgbox Dir(FileCell.Value)

 

[goof2808]

Ok, duidelijk

In het formuliertje staat 3059380_1.xls

 

[edmoor]

En dat zou dus dit moeten zijn: H:\test\3059380_1.xls

 

[goof2808]

Komt het misschien omdat in het begin van de code "dir" niet vermeldt wordt?

Zoiets als Dim dir As Range

 

[edmoor]

Als je een bijlage met een mail wil sturen moet je het volledige pad opgeven. Ik had dan ook verwacht dat dat in de cellen zou staan. Als je alleen de naam van het bestand opgeeft dan heeft de code uiteraard geen idee waar dat bestand vandaan moet komen en wordt er in de huidige map naar gezocht. Daar staat dat bestand niet en krijg je dus de melding dat het opgegeven bestand niet werd gevonden.

 

[goof2808]

In de cellen van R1 t/m V1 staan onderstaande verwijzingen, dus dat zou dan toch ook terug moeten geven?
Of moet ik die tussen aanhalingstekens zetten?

H:\test\3059380_1.???
H:\test\3059380_2.???
H:\test\3059380_3.???
H:\test\3059380_4.???
H:\test\3059380_5.???

Btw: ik ben erg blij dat je me helpt

 

[goof2808]

Maar ik begrijp dat ik het bestand met de code ook gewoon in dezelfde map als de bijlagen kan plaatsen

 

[edmoor]

Dat is op zich goed maar met de originele mapnaam niet erg praktisch. Zet de naam van de map in 1 cel, bijvoorbeeld in W1, en combineer die dan:

Bijlage = Dir(Range("W1") & "\" & FileCell.Value) 
If Bijlage <> "" Then
    .Attachements.Add Bijlage
End If

De variabele Bijlage Dim je dan als String.
Zo hoef je die padnaam maar 1x ergens in te geven en niet in alle cellen van de hele range en maakt het ook niet uit waar het bestand met de code staat.

 

[goof2808]

Krijg onderstaande melding:
Deze eigenschap of methode wordt niet ondersteund door dit object.

In de cellen van R1 t/m V1 staat nu:
3059380_1.???
3059380_2.???
3059380_3.???
3059380_4.???
3059380_5.???

in W1 staat H:\test

De code is nu:

Sub Send_FilesGEADEF()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim Bijlage As String
    

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("mail")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("F").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("R1:V1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = "info@mail.nl"
                .Subject = "" & cell.Offset(0, 17).Value
                .Body = "" & cell.Offset(0, 19).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                    If dir(FileCell.Value) <> "" Then

                    Bijlage = dir(Range("W1") & "\" & FileCell.Value)
                    If Bijlage <> "" Then
                    .Attachements.Add Bijlage

                    End If
                    End If
                    End If
                Next FileCell

                .Display  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub