• 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.

Verplaatsen op waarde van een datum van gisteren

Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.183
Beste,

Ik wil regels verplaatsen op waarde van een datum, maar dan de datum min 1 dag.
Ik moet dus alle regels hebben die gisteren zijn toegevoegd.

Hoe kan ik dit in de code verwerken!

Code: 
   Sheets("blad1").Select
   Dim c As Range
   For Each c In [B1:B10000]
        If c = "hier datum van vandaag min 1 dag" Then
            c.Rows.EntireRow.Copy
            ['blad2'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next


Dan gelijk de vervolg vraag misschien is dat er in te verwerken.
Ik wil dit dan gelijk versturen als body in een mail!
Is dat mogelijk.

groet HWV
 
Code: 
If c = [COLOR="#FF0000"]"hier datum van vandaag min 1 dag"[/COLOR] Then
wordt:
Code: 
If c = [COLOR="#FF0000"]Date - 1[/COLOR] Then
 
werkt goed

:shocked: hoe makkelijk kan het zijn.
Top dank hiervoor.

Nog enig idee hoe ik dit verwerk om dit in een body van de mail te krijgen.
Blijf ook nog wel stoeien, maar als iemand al de oplossing heeft, dan graag!

Groet HWV
 
Graag gedaan!
Voor je vervolg vraag is het misschien handig om nog een representatief voorbeeldbestandje te posten met wat je al hebt.
Want de vraag is natuurlijk wat je precies in de body wilt hebben? De zojuist gekopieerde regels? Of alle regels met een bepaalde datum op het 2e tabblad? Of alles van het 2e tabblad? En om hoeveel kolommen gaat het?
 
Voor je eerste vraag:

Code: 
Sub SjonR()
Dim Datum As String
Datum = Date - 1
With Sheets("Blad1").Cells(1).CurrentRegion
    .AutoFilter 2, Datum
    .Offset(1).Copy ['Blad2'!A65536].End(xlUp).Offset(1)
    .AutoFilter
End With
End Sub

Tweede vraag zou ik advies Gijsbert opvolgen.
 
Laatst bewerkt:
Nu met een voorbeeld bestand

Beste,

Ik heb het even nagebouwd, maar laat wel zien hoe de opbouw is.
Wat in dit geval in de body van de mail moet komen is wat er komt te staan in blad2, wat dynamisch is.
Als het mogelijk incl. opmaak, maar anders niet

Bekijk bijlage Registratie-Documenten.xlsm

Alvast dank

HWV
 
Gebruik je Excel optimaal.
Onzin om die 1/7e deel van kolom A die je nog ziet leeg te laten.
Je maakt het jezelf moeilijk.
Code: 
Sub hsv()
Dim sh As Worksheet
Set sh = Sheets("blad2")
sh.Cells(1).CurrentRegion.Offset(1).ClearContents
 With Sheets("blad1").Cells(1).CurrentRegion
   .AutoFilter 2, , 7, Array(2, Format(Date - 1, "m/d/yyyy"))
   .Offset(1).Copy sh.Range("b2")
   .AutoFilter
 End With
End Sub
 
voorbeel data in de body

Bedankt voor de input.
Ik heb tot nu toe onderstaande om de data te mailen.
Het script ooit gekregen via SNB, en hier en daar wat aangepast.

Enkel hij geef de waarde van de tijd niet goed weer als je de mail gaat samenstellen.
Is dit op te lossen, en tevens is het mogelijk om de opmaak mee te kopiëren.

Datum Tijd Accountmanger Klantnaam Omschrijving Behandelaar Gevraagde leverdatum Formuliernaam
13-3-2018 0,671527777777778 Kees Klant 2 Diverse verpakkingen Henk 15-3-2018 Offertebon
13-3-2018 0,671527777777778 Kees Klant 2 Diverse verpakkingen Henk 15-3-2018 Offertebon
13-3-2018 0,671527777777778 Kees Klant 2 Diverse verpakkingen Henk 15-3-2018 Offertebon

Code: 
Sub Save_Mail_Werkblad_Inhoud_in_de_Body()

c03 = "<table border=0 bgcolor=#FFFFF0#>"

 sn = Sheets("blad2").Range("B1:I30") '.UsedRange
 For j = 1 To UBound(sn)

c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c03 = c03 & "</table><P></P><P></P>"

 With CreateObject("Outlook.Application").createitem(0)
 .To = "hwv@helpmij.nl"
 .CC = ""
 .Subject = "Overzicht lopende documenten"
 .HTMLBody = c03
 .Display
 ''.Send
End With

End Sub

Bekijk bijlage Registratie-Documenten.xlsm

Groet HWV
 
Code: 
Sub Save_Mail_Werkblad_Inhoud_in_de_Body()


c03 = "<table border=0 bgcolor=#FFFFF0#>"


 sn = Sheets("blad2").Range("B1:I30") '.UsedRange
 For j = 1 To UBound(sn)
[COLOR=#0000ff]   sn(j, 2) = format(sn(j, 2), "hh:mm")[/COLOR]
c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c03 = c03 & "</table><P></P><P></P>"


 With CreateObject("Outlook.Application").createitem(0)
 .To = "hwv@helpmij.nl"
 .CC = ""
 .Subject = "Overzicht lopende documenten"
 .HTMLBody = c03
 .Display
 ''.Send
End With


End Sub
 
bereik variable gemaakt

Beste,

Dank voor de input en de oplossing.

Code: 
Sub Save_Mail_Werkblad_Inhoud_in_de_Body()

c03 = "<table border=1 bgcolor=#FFFFF0#>"

 sn = Sheets("blad2").Range("B1:I" & Cells(Rows.Count, 1).End(xlUp).Offset(0).Row)
 For j = 1 To UBound(sn)
   sn(j, 2) = Format(sn(j, 2), "hh:mm")
c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c03 = c03 & "</table><P></P><P></P>"

 With CreateObject("Outlook.Application").createitem(0)
 .To = "hwv@helpmij.nl"
 .CC = ""
 .Subject = "Overzicht lopende documenten"
 .HTMLBody = c03
 .Display
 ''.Send
End With
End Sub

De opmaak ondertussen ook aangepast, en de data variabel gemaakt !

Wat ik mij afvraag, is ook de opmaak van de kop mee te nemen, is enkel een schoonheid dingentje.

Groet HWV
 
Beste,

Beter?
Code: 
Sub Save_Mail_Werkblad_Inhoud_in_de_Body()
 c03 = "<table border=1 bgcolor=#FFFFF0#>"
 With Sheets("blad2")
   .Columns.AutoFit
   sn = .Range("a1").CurrentRegion
 End With
 For j = 1 To UBound(sn)
    sn(j, 3) = Format(sn(j, 3), "hh:mm")
    c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
 Next
c03 = c03 & "</table><P></P><P></P>"


 With CreateObject("Outlook.Application").createitem(0)
   .To = "hwv@helpmij.nl"
   .CC = ""
   .Subject = "Overzicht lopende documenten"
   .HTMLBody = c03
   .Display
 ''.Send
 End With
End Sub
 
beter

Beste,

Dank voor de input.
Ik heb bereikt wat ik wilde bereiken, en kan het gaan toepassen in het originele bestand:thumb::thumb::thumb:

Groet HWV
 
.send geeft een foutmelding

Beste,

Ik ben alles aan het verwerken bij ons op de server (Windows server 2012R2), maar nu krijg ik daar een foutmelding op .send

Fout 287 tijdens uitvoering
Door de toepassing of door object gedefinieerde fout.


Code: 
Sub Save_Mail_Werkblad_Inhoud_in_de_Body()

c03 = "<table border=0 bgcolor=#FFFFF0#>"

sn1 = Sheets("blad2").Range("B2")
 sn = Sheets("blad2").Range("B1:I" & Cells(Rows.Count, 1).End(xlUp).Offset(0).Row)
 For j = 1 To UBound(sn)
   sn(j, 2) = Format(sn(j, 2), "hh:mm")

c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c03 = c03 & "</table><P></P><P></P>"

KopBody = "Raymond," & "<br>" & _
"" & "<br>" & _
"Hieronder vind je de lopende documenten van gisteren " & sn1 & "<br><br>"

VoetBody = "" & "<br>" & _
"Met vriendelijke groet," & "<br><br>" & _
"Administrator" & "<br>"

 With CreateObject("Outlook.Application").createitem(0)
 .To = "hwv@helpmij.nl"
 .CC = ""
 .Subject = "Overzicht lopende documenten"
 .HTMLBody = KopBody & c03 & VoetBody
 ''.Display
[COLOR="#FF0000"][B] .Send[/B][/COLOR]
End With

End Sub

Als ik mijn outlook open zet dan verzend hij wel.
Aangezien ik dit via een scheduled task wil laten uitvoeren moet ik er eerst voor zorgen dat mijn outlook open staan en daarna weer sluit.
Hoe kan ik dit voor elkaar krijgen, of is dit anders op te lossen.

Bekijk bijlage Registratie-Documenten.xlsm

Groet HWV

via scheduled task doe ik het volgende:

Ik open het bestand:
run.bat
Code: 
cscript script.vbs "P:\automatisering\Scripts\Excel Batch script\Registratie-Documenten\Registratie-Documenten.xlsm"

die opent het bestand script.vsb
Code: 
Dim args, objExcel

Set args = WScript.Arguments
Set objExcel = CreateObject ("Excel.Application")

objExcel.Workbooks.open args(0)
objExcel.Visible = true

objExcel.Run "hsv"

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close(0)
objExcel.Quit
 
ik denk dat ik het heb gevonden

Beste,

Ik heb het volgende toegevoegd om Outlook te openen

Code: 
Shell ("OUTLOOK")

En het volgende om deze weer te sluiten

Code: 
Sub CloseOutlook()
 Dim OL As Object
 On Error Resume Next
 Set OL = GetObject(, "Outlook.Application")
 On Error GoTo 0
 If OL Is Nothing Then
 MsgBox "Outlook is not running!"
 Else
OL.Quit
 End If
 End Sub

Helaas sluit hij niet de Outlook als ik het op de server doet, met de run.bat.

Hoe zou ik dit wel werkend kunnen krijgen


Groet HWV
 
Laatst bewerkt:
Openen en sluiten (na 5 seconden van opening).
Code: 
Sub hsv()
   Application.ActivateMicrosoftApp xlMicrosoftMail
   Application.Wait DateAdd("s", 5, Now)
   CreateObject("Outlook.Application").Quit 
End Sub
 
mijn code er dan tussen

Best,

Dien ik mijn code hier tussen te plaatsen.
Of moet ik eerst de draaien en dan de ander er achteraan ?

Groet HWV
 
Als je het apart uitvoert heb je er niet veel aan.

De regels die erin staan plaatsen in jouw code waar nodig lijkt me een strakker plan.
 
makkelijk

Beste HSV,

Het kan allemaal zo makkelijk zijn.
Probleem opgelost!
Dank voor de hulp (alweer)

Groet HWV:thumb:
 
Toch nog problemen

Beste,

Het mailen gaat allemaal goed, er is een maar.
Nu kijkt hij naar gisteren om de regels te kopiëren naar blad2, dus zou vandaag de regels van gisteren (18-03-2018) gekopieerd moeten worden naar blad2 en dan moeten mailen.
Enkel nu mailt hij niks vandaag er staat nu niks in blad2, maar ik krijg niet gevonden waar het probleem nu ligt

Misschien iemand een idee, want gisteren ging het wel goed dus met de mail van eergisteren.

Ik heb het bestandje erbij gedaan zodat er gezien kan worden met welke dat ik werk(wel iets aangepast i.v.m. persoonsgegevens)!

Groet HWV

Bekijk bijlage Registratie-Documenten.xlsm
 
Format van wegschrijven

Ik heb eindelijk ontdekt waar de fout lag.
De registratie wordt gevuld met gegevens vanuit verschillende formulieren.
Enkel die schreef niet weg met het format m/d/yyyy dus dat gaf het probleem zo te zien

Groet HWV
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan