[Excel] exporteer naar ics

Pagina: 1
Acties:

Onderwerpen


Acties:
  • 0 Henk 'm!

  • josoetgebrook
  • Registratie: Oktober 2001
  • Laatst online: 22-01-2024
Ik heb een macro gemaakt om een aantal in excel gemaakte afspraken te exporteren naar een ics bestand.

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Generate_ICS()
    Sheets("Blad4").Select
    Dim rng1 As Range, X, i As Long, v As Long
    Dim objFSO, objFile
    Dim FilePath As String
    FilePath = "G:\rooster.ics"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(FilePath)
    Set rng1 = Range([a5], Cells(Rows.Count, "H").End(xlUp))
    X = rng1
 
    objFile.Write "BEGIN:VCALENDAR" & vbCrLf
    For i = 1 To UBound(X, 1)
        objFile.Write "BEGIN:VEVENT" & vbCrLf & "DTSTART:" & Format(X(i, 2), "yyyymmdd") & vbCrLf & "DTEND:" & Format(X(i, 3), "yyyymmdd") & vbCrLf & "CATEGORIES:Rooster" & _
                      vbCrLf & "SUMMARY:" & X(i, 1) & vbCrLf & "LOCATION:" & X(i, 4) & vbCrLf & "END:VEVENT" & vbCrLf
    Next i
    objFile.Write "END:VCALENDAR"
    
    Sheets("handleiding").Select
    Range("A1").Select
End Sub


De export werkt, maar op regel 9 staat bij Range [a5].
Hierdoor worden de eerste 5 rijen geexporteerd, maar het is eigenlijk de bedoeling dat alle rijen worden geexporteerd tot de eerste lege rij. Iedere lege rij die geexporteerd wordt, levert een agenda-item op die niet goed verwerkt kan worden.

Kan iemand mij hiermee verder helpen?

Acties:
  • 0 Henk 'm!

  • pedorus
  • Registratie: Januari 2008
  • Niet online
Klinkt een beetje alsof je die 5 in een 1 moet veranderen, en ergens een if-je moet toevoegen om te checken of er wel iets staat op de rij (if X(i,1)<>"" then of zoiets). Het lijkt er sterk op dat je dit niet zelf heb geschreven. Vba heeft trouwens built-in filemethodes zodat Scripting.FileSystemObject niet echt nodig is. Succes :p

Vitamine D tekorten in Nederland | Dodelijk coronaforum gesloten


Acties:
  • 0 Henk 'm!

  • Sniffert
  • Registratie: Oktober 2009
  • Laatst online: 06-09 11:45

Acties:
  • 0 Henk 'm!

  • josoetgebrook
  • Registratie: Oktober 2001
  • Laatst online: 22-01-2024
Deze vraag heb ik niet gepost, maar ik was wel bezig hetzelfde script aan te passen voor mijn eigen bestand.
Uiteindelijk is dit de oplossing die ik heb bedacht.

Het werkt, maar misschien kan het makkelijker.

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Generate_ICS()

    Dim Docentafkorting As String
    Sheets("Blad1").Select
    deel2_naam = Range("C3").Value

    Application.Volatile
    Sheets("Blad2").Select
    Range("A:A").Select
    LastUsedRow = Range("A65536").End(xlUp).Row

    Sheets("Blad3").Select
    Dim rng1 As Range, X, i As Long, v As Long
    Dim objFSO, objFile
    Dim FilePath As String
    DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
    Filename = "deel1_naam " & deel2_naam & ".ics"
    FilePath = DTAddress & Filename
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(FilePath)
    
    Set rng1 = Range("A" & (LastUsedRow - 1), Cells(Rows.Count, "H").End(xlUp))
    Sheets("Blad3").Select
    X = rng1
 

     
    objFile.Write "BEGIN:VCALENDAR" & vbCrLf
    For i = 1 To UBound(X, 1)
        objFile.Write "BEGIN:VEVENT" & vbCrLf & "DTSTART:" & Format(X(i, 2), "yyyymmdd") & vbCrLf & "DTEND:" & Format(X(i, 3), "yyyymmdd") & vbCrLf & "CATEGORIES:Rooster" & _
                      vbCrLf & "SUMMARY:" & X(i, 1) & vbCrLf & "LOCATION:" & X(i, 4) & vbCrLf & "END:VEVENT" & vbCrLf
    Next i
    objFile.Write "END:VCALENDAR"
    
    Sheets("handleiding").Select
    Range("A1").Select
End Sub

Acties:
  • 0 Henk 'm!

  • pedorus
  • Registratie: Januari 2008
  • Niet online
[b]josoetgebrook schreef op dinsdag 08 november 2011 @ 14:14:Het werkt, maar misschien kan het makkelijker.
Er staan in ieder geval dingen die niks doen en snel zichtbaar zijn ( Dim Docentafkorting As String, Application.Volatile), wat selects die weg kunnen door bijvoorbeeld Sheets(...).Range(...) te gebruiken, 65536 terwijl ook netjes Rows.Count wordt gebruikt (teveel uitleg), enz. Ik snap trouwens niet waarom je de laatste cel in kolom A en die in H gebruik, vreemde Range. Maar ja, als het werkt dan werkt het, ik heb veel gekkere dingen gezien. :p

Vitamine D tekorten in Nederland | Dodelijk coronaforum gesloten


Acties:
  • 0 Henk 'm!

  • josoetgebrook
  • Registratie: Oktober 2001
  • Laatst online: 22-01-2024
pedorus schreef op woensdag 09 november 2011 @ 00:12:
[...]

Er staan in ieder geval dingen die niks doen en snel zichtbaar zijn ( Dim Docentafkorting As String, Application.Volatile), wat selects die weg kunnen door bijvoorbeeld Sheets(...).Range(...) te gebruiken, 65536 terwijl ook netjes Rows.Count wordt gebruikt (teveel uitleg), enz. Ik snap trouwens niet waarom je de laatste cel in kolom A en die in H gebruik, vreemde Range. Maar ja, als het werkt dan werkt het, ik heb veel gekkere dingen gezien. :p
Bij het aanpassen naar mijn eigen wensen liep ik er tegenaan dat als ik de "H" wijzigde in iets anders (maakt niet uit wat), dat een ander gedeelte (regel 29) een fout opleverde.

Zelfs als ik regel 22 wijzigde naar onderstaande code kreeg ik dezelfde fout:
Visual Basic:
1
Cells(Rows.Count, "H").End(xlUp)


Foutmelding:
Fout 13 tijdens uitvoering:
Typen komen niet met elkaar overeen.

Acties:
  • 0 Henk 'm!

  • Mar2zz
  • Registratie: September 2007
  • Laatst online: 20-08 07:53
gebruik geen h maar het kolomgetal dus 8

Acties:
  • 0 Henk 'm!

  • josoetgebrook
  • Registratie: Oktober 2001
  • Laatst online: 22-01-2024
Mar2zz schreef op woensdag 09 november 2011 @ 12:03:
gebruik geen h maar het kolomgetal dus 8
Ik begrijp niet waarom dit erin moet staan. Ik geef toch via onderstaande code al aan wat de range is.
Visual Basic:
1
Set rng1 = Range("A" & (LastUsedRow - 1)

[ Voor 14% gewijzigd door josoetgebrook op 09-11-2011 12:07 ]


Acties:
  • 0 Henk 'm!

  • Mar2zz
  • Registratie: September 2007
  • Laatst online: 20-08 07:53
niet gezien, zit op telefoon zal thuis ff wat beter naar je vba loeren.

Acties:
  • 0 Henk 'm!

  • Mar2zz
  • Registratie: September 2007
  • Laatst online: 20-08 07:53
Als ik het goed begrijp wil je dus het volgende:
van elke rij in een kolom een agenda-item maken, maar dat gaat mis als er een lege rij is?

volgens mij hoeft dat niet zo ingewikkeld als hierboven toch? pseudo
Visual Basic:
1
2
3
4
5
6
7
LastRow = Cells(Rows.Count, 8).End(xlUp).Row
FinalRange = Range(Cells(1,8), Cells(LastRow,8))
For Each cell in FinalRange
    If Not cell = vbNullstring Then
        insert jouw exportcode
    End if
Next cell

[ Voor 5% gewijzigd door Mar2zz op 09-11-2011 12:56 . Reden: fixed range ]


Acties:
  • 0 Henk 'm!

  • josoetgebrook
  • Registratie: Oktober 2001
  • Laatst online: 22-01-2024
Het gaat niet mis bij een lege rij, maar ik wil dat het stopt bij een lege rij.

Zet ik een vast aantal rijen zie in post 1 '[a5]' dan maakt hij van alle lege rijen ook een item. Deze items hebben dan geen onderwerp en ook geen begin en eindtijd, dus zijn er agenda-programma's die dit niet kunnen verwerken (bijv. Google Calendar). MS Outlook maakt er items van 1 uur van op het moment van importeren (is dus ook niet goed).

Acties:
  • 0 Henk 'm!

  • Mar2zz
  • Registratie: September 2007
  • Laatst online: 20-08 07:53
Mar2zz schreef op woensdag 09 november 2011 @ 12:48:

volgens mij hoeft dat niet zo ingewikkeld als hierboven toch? pseudo
Visual Basic:
1
2
3
4
5
6
7
8
9
10
LastRow = Cells(Rows.Count, 8).End(xlUp).Row
FinalRange = Range(Cells(1,8), Cells(LastRow,8))
For Each cell in FinalRange
    If cell = vbNullstring Then
        Exit For
    End if

Insert jouw code

Next cell
Ik weet niet of outlook volledig compatible is met importeren van ics, maar je kan eventueel de agendatimes rechtstreeks naar outlook pushen met de Microsoft Outlook libraries.

[ Voor 17% gewijzigd door Mar2zz op 09-11-2011 13:23 ]


Acties:
  • 0 Henk 'm!

  • josoetgebrook
  • Registratie: Oktober 2001
  • Laatst online: 22-01-2024
Dat heb ik er ook al in zitten, maar om ook de mogelijkheid voor een export te hebben voor mensen die geen outlook hebben, wilde ik ook kunnen exporteren naar ics.

Acties:
  • 0 Henk 'm!

  • Mar2zz
  • Registratie: September 2007
  • Laatst online: 20-08 07:53
Ok. Je zou er goed aan doen om alle selects om te zetten naar normale ranges. Daar wordt je code overzichtelijker van. En lange regels over meer lijnen uitsmeren, in plaats van 1x & _ gebruiken. Dan is het ook makkelijker voor anderen om te zien wat er gebeurt.

Sheets("Blad1").Select
deel2_naam = Range("C3").Value
= hetzelfde als: deel2_naam = Sheets("Blad1").Range("C3").Value

Geloof me, ik nam eerst ook macro's op en dan ging ik ze verder uitwerken, maar zodra je die selects allemaal weghaalt wordt alles makkelijker en overzichtelijker, en hoef je ook niet steeds screenupdating = false overal te doen omdat excel anders gaat flipperen.
Pagina: 1