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

ics file generen met autofilter

Status
Niet open voor verdere reacties.

gober

Gebruiker
Lid geworden
12 feb 2016
Berichten
133
Ik heb een macro welke een ICS file genereerd. dat gaat goed. heb echter een autofilter aangezet welke filtert op naam.
Wil graag alleen van de betreffende naam agenda regels genereren. hij genereerd echter een ics file van alle namen. Hoe kan ik dat inbouwen in onderstaande macro?
ben al een paar uur aan het zoeken geweest.
Code:
Sub Generate_ICS()
    ActiveSheet.Select
    Dim rng1 As Range, X, i As Long, n As Long, naam As String
    Dim objFSO, objFile
    Dim FilePath As String
    FilePath = ThisWorkbook.Path & "\" & ActiveSheet.Name & "-agenda" & ".ics" 'evt naam aanpassen
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(FilePath)
    'Set rng1 = Range("A2", Cells(Rows.Count, 8).End(xlUp))
    Set rng1 = Range("A2", Cells(Rows.Count, 8).End(xlUp))
    
    
     

    
      objFile.Write "BEGIN:VCALENDAR" & vbCrLf & "VERSION:2.0" & vbCrLf
    
    For i = 1 To UBound(X, 1)
   If Not rng1(i, 1).Value = "" Then     'lege agenda regels overslaan (hier moet eigenlijk komen niet gefilterde regels overslaan)
    'If Not Rows(i.Row).Hidden = False Then
        If (X(i, 3) = "") Then          'geen begintijd ingevuld dan agenda gebeurtenis voor de hele dag
        objFile.Write "BEGIN:VEVENT" & vbCrLf & "DTSTART;VALUE=DATE:" & Format(X(i, 2), "yyyymmdd") & vbCrLf & "DTEND;VALUE=DATE:" & Format(X(i, 4), "yyyymmdd") & vbCrLf & "DESCRIPTION:" & X(i, 6) & _
                     vbCrLf & "SUMMARY:" & X(i, 1) & vbCrLf & "LOCATION:" & X(i, 7) & vbCrLf & "END:VEVENT" & vbCrLf
        Else
        
        objFile.Write "BEGIN:VEVENT" & vbCrLf & "DTSTART:" & Format(X(i, 2), "yyyymmdd") & "T" & Format(X(i, 3), "HHMMSS") & vbCrLf & "DTEND:" & Format(X(i, 4), "yyyymmdd") & "T" & Format(X(i, 5), "HHMMSS") & vbCrLf & "DESCRIPTION:" & X(i, 6) & _
                     vbCrLf & "SUMMARY:" & X(i, 1) & vbCrLf & "LOCATION:" & X(i, 7) & vbCrLf & "END:VEVENT" & vbCrLf
    End If
    End If
    Next i
    objFile.Write "END:VCALENDAR"
    MsgBox "opgeslagen in: " & ThisWorkbook.Path & "\" & ActiveSheet.Name & "-agenda" & ".ics" 'evt naam aanpassen
    
End Sub
 
Probeer het eens zo:
Code:
    Set rng1 = Range("A2", Cells(Rows.Count, 8).End(xlUp)).SpecialCells(xlVisible)
 
de code aangerijkt door ahulpje werkte nog niet helemaal goed. Hij maakte alleen agenda bestanden tot aan de eerste niet gefliterde regel.
Heb er dit van gemaakt:
Set rng1 = Range("A2", Cells(Rows.Count, 8).End(xlUp)) Deze regel in tact gelaten.


If Not rng1(i, 1).EntireRow.Hidden Then deze regel toegevoegd.

Daarna werkte het wel.
 
Betrefd opmerking bns,

Dit is een forum voor oplossingen in excel. Het is geen forum over de nederlandse taal over de D's en de T's. Een ieder zijn vak. Ik weet niet of de Heer of mevrouw of het, zelf wel eens in huis klusd of dat hij dat uitbesteed.
Wt zou de heer bns zeggen als hij zelf klusd en ik zou de opmerking maken, dat behang niet rechd is en de muur niet dekkend is geschilderdt en de schutting scheef en niet waterpas staad?

Ik heb trouwens een paar schrijffauten gemaakd. zou je die nog even voor mij willen verbeteren?
BVD.
 
Volgens de door jou geplaatste code kan het eigenlijk niet werken, want X krijgt nergens een waarde.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan