Ich habe mir einen Kalender erstellt und möchte darin auf Knopfdruck unter Linux von der Seite "http://www.schulferien.org/iCal/" die (2015er niedersächsischen) Feiertage downloaden, ohne den Browser öffnen zu müssen. Zufällig fand ich Frieder D.'s Makro "Download To File", mit dem bei mir anstelle der 3,3 kb großen Datei "Feiertage_Niedersachsen_2015.ics" allerdings nur eine 0 Byte große Datei gespeichert wird.
Wer weiß Rat?
Gruß
Uwe
Ich verwende: LibreOffice 3.5.4.2
Build-ID: 165a79a-7059095-e13bb37-fef39a4-9503d18
Code: Alles auswählen
REM ***** BASIC *****
'Copyright (c) 2011 Frieder Delor, Mailto: delorfr@googlemail.com
'The Funktion "GetPath" is originally from: Copyright (c) 2011 Volker Lenhardt
'This program is free software; you can redistribute it and/or modify it under
'the terms of the GNU General Public License as published by the Free Software
'Foundation; either version 2 of the License, or (at your option) any later
'version.
'This program is distributed in the hope that it will be useful, but WITHOUT
'ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
'FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
'You should have received a copy of the GNU General Public License along with
'this program; if not, write to the Free Software Foundation, Inc., 59 Temple
'Place, Suite 330, Boston, MA 02111-1307 USA
' ========================================================================
Option Explicit
'-----------------------------------------------
Sub DownloadToFile
Dim iSystem%
Dim sURL As String
Dim sPath$
'internetAdresse muss ein direkter Link zum Download sein
sURL="http://www.schulferien.org/iCal/getfile?name=Feiertage_Niedersachsen_2015.ics" 'OriginalLink: http://www.schulferien.org/iCal/Feiertage/icals/Feiertage_Niedersachsen_2015.ics
'pfad auf dem Rechner
sPath = GetPath
If sPath = "" Then
MsgBox "Sie haben kein Verzeichnis ausgewählt" _
,0 ,"Fehler"
Exit sub
End if
sPath = ConvertFromUrl(sPath)
sPath = sPath & "Feiertage_Niedersachsen_2015.ics" 'bitte anpassen
iSystem = GetGUIType
select case iSystem
Case 1 'Das betriebssysthem ist Windows
Win_Download (sURL, sPath )
case 3 'Mac os
MsgBox "Leider funktioniert das Makro nicht unter Mac-OS." _
,0 ,"Fehler"
case 4 'Unix oder Linux
Linux_Download (sURL, sPath )
case else
MsgBox "Das Betriebssystem konnte nicht ermittelt werden." _
,0 ,"Fehler"
end select
end sub
'--------------------------------------------------------------------------------------------
Sub Linux_Download (sURL As String, sPath As String )
Dim iVar%,i%
dim dummy()
if FileExists(sPath)Then
iVar = MsgBox ("Die Datei " & Chr(10) & sPath & Chr(10) & " existiert bereits." & Chr(10) & _
"Soll die vorhandene Datei überschrieben werden?",4,"Fehler")
if iVar =7 Then exit Sub
End if
'Datei herunterladen
Shell("wget -q " & sURL &" -O " & "'" & sPath & "'")
For i=1 To 10
Wait 3000
If FileExists(sPath) Then Exit For 'bis zu 10 sekunden Warten, bis der download abgeschlossen ist
Next
If Not FileExists(sPath) Then 'Fehler nach 10 sekunden
MsgBox "Die Datei konnte nicht heruntergeladen werden. " & Chr(10) & _
"Bitte überprüfen sie die Internetadresse." ,0, "Fehler"
exit Sub
Else
MsgBox "Der Download war erfolgreich. " ,0, "Erfolg"
End If
End Sub
'---------------------------------------------------------------------
Sub Win_Download(sURL As String, sPath As String )
Dim iVar%
if FileExists(sPath)Then
iVar = MsgBox ("Die Datei " & Chr(10) & sPath & Chr(10) & " existiert bereits." & Chr(10) & _
"Soll die vorhandene Datei überschrieben werden?",4,"Fehler")
if iVar =7 Then exit Sub
End if
'Datei herunterladen
If DownloadFile(sURL, sPath) = False Then
MsgBox "Die Datei konnte nicht heruntergeladen werden. " & Chr(10) & _
"Bitte überprüfen sie die Internetadresse." ,0, "Fehler"
exit Sub
Else
MsgBox "Der Download war erfolgreich. " ,0, "Erfolg"
End If
End Sub
'--------------------------------------------------------------------------------
'Die Funktion "urlmon" aus der Windows API aufrufen
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
'-------------------------------------------------------------------------
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
'--------------------------------------------------------------------------
'Ordner über den Ordnerauswahl-Dialog holen
Function GetPath() As String
Dim oPathSettings, oFolderDialog
Dim sPath As String
oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
sPath = oPathSettings.Work
oFolderDialog = _
CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderDialog.SetDisplayDirectory(sPath)
If oFolderDialog.Execute() = _
com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
sPath = oFolderDialog.GetDirectory
Else
GetPath = ""
Exit Function
End If
If Right(sPath, 1) <> "/" Then sPath = sPath & "/"
GetPath = sPath
End Function
