[Duda] Insertar a este código, Mensaje de Error en caso de...

[Soir]

Hola!...


Bueno, tengo una duda, y msdn, no me ayuda mucho en esto...

Tengo el siguiente código.

Código [Seleccionar] Expandir


Private Sub cmdDownload_Click()
Screen.MousePointer = vbHourglass

ProgressBar1.Value = 0

ProgressBar1.Visible = True 'Mostrar barra de progreso

'Lista de Archivos de Descarga
DownloadFile "http://dynamite.es/updates/WoD.exe", App.Path & "\WoD.exe"
DownloadFile "http://dynamite.es/updates/Patch-a.MPQ", App.Path & "\Data\Patch-a.MPQ"

Screen.MousePointer = vbDefault
MsgBox "Actualización Completada"

ProgressBar1.Visible = False

End Sub

Private Sub Form_Load()

Me.Caption = "Dynamite Updater - V1.0"

ProgressBar1.Visible = True

End Sub

Sub DownloadProgress(intPercent As String)
   ProgressBar1.Value = intPercent ' Actualizar Proceso Mientras se Descarga
End Sub


'Funcion de Descarga de Archivo (strURL As String, strDestination As String) As Boolean
Public Sub DownloadFile(strURL As String, strDestination As String) 'As Boolean
Const CHUNK_SIZE As Long = 1024
Dim intFile As Integer
Dim lngBytesReceived As Long
Dim lngFileLength As Long
Dim strHeader As String
Dim b() As Byte
Dim i As Integer

DoEvents
   
With Inet1
   
.URL = strURL
.Execute , "GET", , "Range: bytes=" & CStr(lngBytesReceived) & "-" & vbCrLf
       
While .StillExecuting
DoEvents
Wend

strHeader = .GetHeader
End With
   
   
strHeader = Inet1.GetHeader("Content-Length")
lngFileLength = Val(strHeader)

DoEvents
   
lngBytesReceived = 0

intFile = FreeFile()

Open strDestination For Binary Access Write As #intFile

Do
b = Inet1.GetChunk(CHUNK_SIZE, icByteArray)
Put #intFile, , b
lngBytesReceived = lngBytesReceived + UBound(b, 1) + 1

DownloadProgress (Round((lngBytesReceived / lngFileLength) * 100))
DoEvents
Loop While UBound(b, 1) > 0

Close #intFile

End Sub


Este código lo uso para actualizar unos archivos de un juego... Que son imprescindibles para mi servidor.

La duda, es, el programa descarga los archivos y uno de esos archivos, lo inserta en la carpeta \Data\

Entonces, quería saber, como insertarle un mensaje para que cuando el programa no encuentre la carpeta \Data\ salga X mensaje.

Ahora, cuando no la encuentra sale este error:



Espero la ayuda... Muchas gracias

[Fitoschido]

Código (vb) [Seleccionar] Expandir

On Error GoTo RutinaError

...

RutinaError:


Y bajo RutinaError pones:

Si Carpeta "\Data" no existe Entonces
MsgBox "No se encontró la carpeta de datos del juego" (o lo que quieras.

Te lo pongo como pseudocódigo porque no sé si lo de FileExists existe en VB6, y no me acuerdo ahorita

[Soir]

Código (vb) [Seleccionar] Expandir

On Error GoTo RutinaError

...

RutinaError:


Y bajo RutinaError pones:

Si Carpeta "\Data" no existe Entonces
MsgBox "No se encontró la carpeta de datos del juego" (o lo que quieras.

Te lo pongo como pseudocódigo porque no sé si lo de FileExists existe en VB6, y no me acuerdo ahorita

Mira se lo inserte aqui:

Código [Seleccionar] Expandir


Private Sub cmdDownload_Click()
Screen.MousePointer = vbHourglass

ProgressBar1.Value = 0

ProgressBar1.Visible = True 'Mostrar barra de progreso

'Lista de Archivos de Descarga
DownloadFile "http://dynamite.es/updates/WoD.exe", App.Path & "\WoD.exe"
DownloadFile "http://dynamite.es/updates/Patch-a.MPQ", App.Path & "\Data\Patch-a.MPQ"

[b]On Error GoTo RutinaError
RutinaError:
MsgBox "No se encontró la carpeta de datos del juego"[/b]


Screen.MousePointer = vbDefault
MsgBox "Actualización Completada"

ProgressBar1.Visible = False

End Sub

Private Sub Form_Load()

Me.Caption = "Dynamite Updater - V1.0"

ProgressBar1.Visible = True

End Sub

Sub DownloadProgress(intPercent As String)
    ProgressBar1.Value = intPercent ' Actualizar Proceso Mientras se Descarga
End Sub


'Funcion de Descarga de Archivo (strURL As String, strDestination As String) As Boolean
Public Sub DownloadFile(strURL As String, strDestination As String) 'As Boolean
Const CHUNK_SIZE As Long = 1024
Dim intFile As Integer
Dim lngBytesReceived As Long
Dim lngFileLength As Long
Dim strHeader As String
Dim b() As Byte
Dim i As Integer

DoEvents
   
With Inet1
   
.URL = strURL
.Execute , "GET", , "Range: bytes=" & CStr(lngBytesReceived) & "-" & vbCrLf
       
While .StillExecuting
DoEvents
Wend

strHeader = .GetHeader
End With
   
   
strHeader = Inet1.GetHeader("Content-Length")
lngFileLength = Val(strHeader)

DoEvents
   
lngBytesReceived = 0

intFile = FreeFile()

Open strDestination For Binary Access Write As #intFile

Do
b = Inet1.GetChunk(CHUNK_SIZE, icByteArray)
Put #intFile, , b
lngBytesReceived = lngBytesReceived + UBound(b, 1) + 1

DownloadProgress (Round((lngBytesReceived / lngFileLength) * 100))
DoEvents
Loop While UBound(b, 1) > 0

Close #intFile

End Sub


Y sale, cuando descarga los archivos, salen los 2 mensajes...

Probaré a cambiarlo de lugar...

Gracias ^^

[cassiani]

debes colocar un Exit Function antes de la etiqueta RutinaError

Así está mal:

Código [Seleccionar] Expandir

[b]On Error GoTo RutinaError
RutinaError:
MsgBox "No se encontró la carpeta de datos del juego"[/b]


Screen.MousePointer = vbDefault
MsgBox "Actualización Completada"

ProgressBar1.Visible = False

End Sub

La etiqueta RutinaError la pones al final del sub, la idea es que el procedimiento que sigue luego de ella se ejecute solo si se produce el error

[Fitoschido]

Haz lo que te dice Cassiani, y quitale los "[ b ]" que hay en la etiqueta... ¿No te causa Syntax Error? xD