Visual Basic - No responde

Life is soft - evento anual de software empresarial
 
Vista:

No responde

Publicado por Lorena (11 intervenciones) el 05/08/2017 15:56:42
Buenas tardes, tengo un código creado con el que me busca dentro de los usuarios y me copia las carpetas que le indico. El problema que cuando tienen muchos datos se queda en No responde hasta que acaba.
He estado leyendo sobre DoEvents pero no doy con ello.

Os dejo un poco del código por si a alguien se le ocurre algo.

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
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
	Dim os As String = System.Environment.OSVersion.Version.Major
	On Error Resume Next
	If os = 5 Then
		Dim carpetas() As String = Directory.GetDirectories(copia)
		For Each carpeta As String In carpetas
			ListBox1.Items.Add(carpeta)
				For i As Integer = 0 To Me.ListBox1.Items.Count - 1
				Me.ListBox1.SetSelected(i, True)
				Application.DoEvents()
				Next
				Directory.CreateDirectory(destino & "\" & Path.GetFileName(ListBox1.SelectedItem))
				Dim fso As New FileSystemObject
			fso = New FileSystemObject
				If Directory.Exists(ListBox1.SelectedItem & "\Mis Documentos") Then
				fso.CopyFolder((ListBox1.SelectedItem & "\Mis Documentos"), destino & "\" & Path.GetFileName(ListBox1.SelectedItem) & "\Mis Documentos")
				End If
				If Directory.Exists(ListBox1.SelectedItem & "\Escritorio") Then
				fso.CopyFolder((ListBox1.SelectedItem & "\Escritorio"), destino & "\" & Path.GetFileName(ListBox1.SelectedItem) & "\Escritorio")
				End If
				If Directory.Exists(ListBox1.SelectedItem & "\Favoritos") Then
				fso.CopyFolder((ListBox1.SelectedItem & "\Favoritos"), destino & "\" & Path.GetFileName(ListBox1.SelectedItem) & "\Favoritos")
				End If
			fso = Nothing
		Next
			MsgBox("Copia de perfiles terminada satisfactoriamente", vbOKOnly + vbInformation, "Copia Correcta")
	Else
		MsgBox("Copia de perfiles incorrecta", vbOKOnly + vbInformation, "Copia fallida")
	End If
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

No responde

Publicado por Antoni Masana (557 intervenciones) el 07/08/2017 10:23:37
El DoEvents es como una puerta de salida a la hora de procesar una serie de instrucciones de una rutina SUB, una MACRO o un EVENTO.

Cuando escribes un código como el que pones arriba Windows SOLO ejecuta tu codigo y no puede atender otras peticiones, es decir no se puede ejecutar ningún proceso hasta que finaliza el código y por esto sale el mensaje de que no responde y el windows se queda como congelado.

Añadiendo unos cuantos DoEvents estratégicamente se soluciona el problema:

Hay 2 DoEvents, uno antes de cada NEXT. Con esto deberá funcionar

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
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
    Dim os As String = System.Environment.OSVersion.Version.Major
    On Error Resume Next
    If os = 5 Then
        Dim carpetas() As String = Directory.GetDirectories(copia)
 
        For Each carpeta As String In carpetas
            ListBox1.Items.Add(carpeta)
            For i As Integer = 0 To Me.ListBox1.Items.Count - 1
                Me.ListBox1.SetSelected(i, True)
                DoEvents
            Next
 
            Directory.CreateDirectory(destino & "\" & Path.GetFileName(ListBox1.SelectedItem))
            Dim fso As New FileSystemObject
            fso = New FileSystemObject
 
            If Directory.Exists(ListBox1.SelectedItem & "\Mis Documentos") Then
                fso.CopyFolder((ListBox1.SelectedItem & "\Mis Documentos"), destino & "\" & Path.GetFileName(ListBox1.SelectedItem) & "\Mis Documentos")
            End If
 
            If Directory.Exists(ListBox1.SelectedItem & "\Escritorio") Then
                fso.CopyFolder((ListBox1.SelectedItem & "\Escritorio"), destino & "\" & Path.GetFileName(ListBox1.SelectedItem) & "\Escritorio")
            End If
 
            If Directory.Exists(ListBox1.SelectedItem & "\Favoritos") Then
                fso.CopyFolder((ListBox1.SelectedItem & "\Favoritos"), destino & "\" & Path.GetFileName(ListBox1.SelectedItem) & "\Favoritos")
            End If
            fso = Nothing
            DoEvents
        Next
        MsgBox("Copia de perfiles terminada satisfactoriamente", vbOKOnly + vbInformation, "Copia Correcta")
    Else
        MsgBox("Copia de perfiles incorrecta", vbOKOnly + vbInformation, "Copia fallida")
    End If
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar

No responde

Publicado por Lorena (11 intervenciones) el 07/08/2017 19:03:55
Ante todo muchas gracias, he intentado meterlo pero me dice que no está declarado...
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

No responde

Publicado por Lorena (11 intervenciones) el 07/08/2017 23:19:51
Ya lo conseguí, me tiendo my.Application.DoEvents(). Con ello hasta pude meter un gif de procesando...

Muchas gracias
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar