• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Blad verzenden

Status
Niet open voor verdere reacties.
E

ExcelNoob

Gebruiker
Lid geworden
20 apr 2007
Berichten
227
Hi Folks,

Ik heb een macro opgenomen in mijn excelformulier met een code die ik van een andere vraag heb. Maar hij doet het niet. Hij geeft wel aan dat hij het doet, maar hij verstuurd niets.
Dit is de code:
Code: 
Sub Emailen()
'Working in 97-2007
    Dim wb As Workbook
    Dim Shname As Variant
    Dim Addr As Variant
    Dim FileExtStr As String
    Dim FileFormatNum As Long
 
    Shname = Array("PMF")
    Addr = Array("test@test.nl")
 
    If Val(Application.Version) >= 12 Then
        'You run Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    End If
 
End Sub

Heb het emailadres ff gewijzigd.

Kan iemand helpen?
 
Waarom niet zo:
Code: 
Sub email()
    
    ontvanger = "jouw email adres"
    onderwerp = "Email vanuit Excel"
    ActiveWorkbook.SendMail Recipients:=ontvanger, Subject:=onderwerp
    
    MsgBox "Het formulier is verzonden naar: " & ontvanger
 
End Sub

of kijk eens hier:
http://www.rondebruin.nl/sendmail.htm
 
Laatst bewerkt:
welk email programma gebruik je?
deze code werkt Outlook.

edit:
code iets aangepast.
 
Outlook,

maar ik heb al een code gevonden die werkt, en krijg hem ook wel zo aangepast dat hij naar het goede emailadres stuurt, maar niet het onderwerp. Ik wil graag dat het onderwerp de naam van het blad wordt en daarbij de waarde in cel D8 toevoegd. Ik heb het wel al voorelkaar met de opslaanmacro, maar krijg het hier niet voorelkaar.

Dit is de code die ik van Rondebruin.nl heb:
Code: 
Sub Mail_ActiveSheet()
'Working in 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007
            'We exit the sub when your answer is NO in the security dialog that you only
            'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail "test@test.nl", _
                  "This is the Subject line"
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Zou je me kunnen helpen?
 
Laatst bewerkt:
Hij geeft aan dat ie voor dit stukje
Code: 
" & Range("
een instructie-einde verwacht??:shocked:

En hij mailed hem als ActiveSheet.Name:S
 
Laatst bewerkt:
Probeer dit stukje code:
Code: 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail "sjaak.hummel@groningen.politie.nl", _
                  "This is the Subject line"
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

te vervangen door:
Code: 
Onderwerp = ActiveSheet.Name & " " & Range("D8").value  

With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail "sjaak.hummel@groningen.politie.nl", Onderwerp
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
En nu wil dat ie hem eerst opslaat als actieve blad en waarde D8. Maar ik kan sub niet gebruiken toch? ik heb deze code nu:
Code: 
Sub Savefile()
ActiveWorkbook.SaveAs Filename:="H:\Mijn Documenten\PMF" & Range("D8").Value & ".xls"
End Sub
 
Erste dingen eerst!
Werkt je email nu?
En wie wil hem opslaan? Jij of de VBA code?
 
Sorry, je hebt gelijk.

Ja, de email werkt nu! Bedankt voor je hulp daarmee!:D

En ik wil zelf graag dat ie hem eerst opslaat voor dat het formulier verzonden wordt.
Hoop dat je me hiermee ook kan helpen :)
 
Probeer deze code eens:
Opslaan doet hij aan het begin van je file, email en onderwerp zijn nu aparte variabelen en onderaan heb ik nog een msgbox geplaatst.
Code: 
Sub Mail_ActiveSheet()
'Working in 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
    
    'Opslaan file
    Opslaan_file = "H:\Mijn Documenten\PMF" & Range("D8").Value & ".xls"
    ActiveWorkbook.SaveAs Filename:=Opslaan_file
    
    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007
            'We exit the sub when your answer is NO in the security dialog that you only
            'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & ""
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
 
    Onderwerp = ActiveSheet.Name & " " & Range("D8").Value
    Emailadres = "sjaak.hummel@groningen.politie.nl"
    
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail Emailadres, Onderwerp
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    'geef melding weer
    MsgBox "File is per email verzonden aan: " & Emailadres & " en tevens opgeslagen op locatie: " & Opslaan_file
    
End Sub
 
Hij werkt niet, maar heb het al anders opgelost. Heb gewoon twee aparte knoppen gemaakt, dan slaan ze hem maar op voordat ie verstuurd wordt

Toch bedankt voor je inspanningen!:thumb:

Mvg
 
Als ik hem hier test op de c:\ dan werkt hij ok.

Je kan ook een module binnen een module aanroepen:
Code: 
sub email()

'hieronder de naam van je te laten runnen module
save_file

End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan