Jump to content
Ana_Moreira

Ciclo While

Recommended Posts

Ana_Moreira

boas pessoal...

estou a desenvolver um programa de backup's.. mas estou com um pequeno problema.. quando o meu programa faz a pesquisa das base de dados, ele só encontra uma de cada extençao por pasta.. e percisava que listasse todas as base de dados..

aqui vai o meu codigo:

Private Sub FSO_sqlserver(ByVal sPath As String, Optional ByVal bshowdialog As Boolean = False)

Dim folder As folder
Dim subfolder As folder
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    lblpasta.Caption = sPath
    DoEvents
Set folder = fso.GetFolder(sPath)
If Dir(sPath & "*.mdf") <> "" Then

If (sPath <> "*.mdf") Then
    List1.AddItem (Dir(sPath & "*.mdf"))
    List2.AddItem (sPath)
End If
ElseIf Dir(sPath & "*.ldf") <> "" Then
List1.AddItem (sPath)

    On Local Error Resume Next
      If folder.SubFolders.Count > 0 Then
        For Each subfolder In folder.SubFolders
           FSO_sqlserver sPath & subfolder.Name, bshowdialog
        Next
      End If
    Else
        lblpasta = ""
        Exit Sub
    End If
          DoEvents
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
        lblpasta.Caption = sPath
        DoEvents
        Set folder = fso.GetFolder(sPath)
            If Dir(sPath & "*.ldf") <> "" Then
                List1.AddItem (Dir(sPath & "*.ldf"))
                Me.List2.AddItem sPath
            End If
On Local Error Resume Next
    If folder.SubFolders.Count > 0 Then
        For Each subfolder In folder.SubFolders
            FSO_sqlserver sPath & subfolder.Name, bshowdialog
        Next
    End If

será que com um ciclo while resolvo este problema?


A'MoreiraEu sobrevivi ao fim do mundo (: ahahahhttp://lmgtfy.com/?q=digite+aqui+sua+duvida+que+eu+te+respondo!

Share this post


Link to post
Share on other sites
Super Oliks

Tente trocar "GetFolder" por "GetFile", pois asssim acredito que ira procurar arquivo por arquivo.  🤔

Share this post


Link to post
Share on other sites
Ana_Moreira

exprimentei, e assim nem começa a procurar.. :S

um ciclo while faz sentido, mas nao sei como ele vai saber que chegou ao fim!


A'MoreiraEu sobrevivi ao fim do mundo (: ahahahhttp://lmgtfy.com/?q=digite+aqui+sua+duvida+que+eu+te+respondo!

Share this post


Link to post
Share on other sites
joaocardoso

exprimentei, e assim nem começa a procurar.. :S

um ciclo while faz sentido, mas nao sei como ele vai saber que chegou ao fim!

Já experimentaste algo do genero (código de notepad não testado :) ):

   For Each f In folder.Files
         If Right(f.Path, 4) = ".mdf" Or Right(f.Path, 4) = ".ldf" Then
            List1.AddItem f.Path
         End If
   Next

Sendo que f é uma variavel do tipo File.

Cheers

João Cardoso


Cumps,

João Cardoso

-------------------------------------

Nokia Developer Moderator

Nokia Developer Champion

AciNet

Share this post


Link to post
Share on other sites
Ana_Moreira

aqui esta o codigo que funciona:

'Aqui um botão "pesquisar"


Private Sub cmdpesquisar_Click()

    PastaBackup = ""

    Timer1.Interval = 0

    Me.lst1.ListItems.Clear

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Drives = Fso.Drives

    For Each Drive In Drives
        If Drive.DriveType = Fixed Then
            FSO_sqlserver Drive.DriveLetter & ":\"
        End If
    Next

    LVZebra Me.lst1, Picture1, vbWhite, RGB(220, 220, 220), Form1

    Me.lblpasta.Caption = "Fim da Pesquisa da Base De Dados"

    Me.SaveAs.Enabled = True

End Sub



'Aqui uma função

Private Sub FSO_sqlserver(ByVal sPath As String, Optional ByVal bshowdialog As Boolean = False)

    Dim folder As folder
    Dim subfolder As folder
    Dim cArquivo As String

    On Error Resume Next

    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    lblpasta.Caption = sPath
    DoEvents

    Set folder = Fso.GetFolder(sPath)

    If UCase(folder) = UCase("c:\Backup") Then
        GoTo Proxima
    End If

    cArquivo = Dir(sPath & "*.mdf")
    If Dir(sPath & "*.mdf") <> "" Then
        Do While Not cArquivo = ""
            lst1.ListItems.add (Me.lst1.ListItems.Count + 1), , sPath
            lst1.ListItems(Me.lst1.ListItems.Count).ListSubItems.add 1, , (cArquivo)
            cArquivo = Dir()
        Loop
    End If

    cArquivo = Dir(sPath & "*.ldf")
    If Dir(sPath & "*.ldf") <> "" Then
        Do While Not cArquivo = ""
            lst1.ListItems.add (Me.lst1.ListItems.Count + 1), , (sPath)
            lst1.ListItems(Me.lst1.ListItems.Count).ListSubItems.add 1, , (cArquivo)
            cArquivo = Dir()
        Loop
    End If

    DoEvents

    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    lblpasta.Caption = sPath
    DoEvents

    Set folder = Fso.GetFolder(sPath)

    If UCase(folder) = UCase("c:\backup\") Then
        GoTo Proxima
    End If

Proxima:

    If folder.SubFolders.Count > 0 Then
        For Each subfolder In folder.SubFolders
            FSO_sqlserver sPath & subfolder.Name, bshowdialog
        Next
    End If

End Sub

Private Sub Combo1_Click()

    Text1.Text = Combo1.Text

End Sub

'Este código num módulo

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Public Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Function LVZebra(LV As ListView, Pic As PictureBox, Cor1 As Long, Cor2 As Long, Form As Form) As Boolean

    Dim lHght As Long
    Dim lWdth As Long

    LVZebra = False

    If LV.View <> lvwReport Then Exit Function
    If LV.ListItems.Count = 0 Then Exit Function

    With LV
        .Picture = Nothing
        .Refresh
        .Visible = True
        .PictureAlignment = lvwTile
        lWdth = .Width
    End With

    With Pic
        .AutoRedraw = False
        .Picture = Nothing
        .BackColor = vbWhite
        .Height = 1
        .AutoRedraw = True
        .BorderStyle = vbBSNone
        .ScaleMode = vbTwips
        .Top = Form.Top - 10000
        .Width = Screen.Width
        .Visible = False
        .Font = LV.Font

        With .Font
            .Bold = LV.Font.Bold
            .Charset = LV.Font.Charset
            .Italic = LV.Font.Italic
            .Name = LV.Font.Name
            .Strikethrough = LV.Font.Strikethrough
            .Underline = LV.Font.Underline
            .Weight = LV.Font.Weight
            .Size = LV.Font.Size
        End With

        lHght = LV.ListItems(1).Height

        .Height = lHght * 2
        .Width = lWdth

        Pic.Line (0, 0)-(lWdth, lHght), Cor1, BF
        Pic.Line (0, lHght)-(lWdth, (lHght * 2)), Cor2, BF
        .AutoSize = True
        .Refresh

    End With

    LV.Refresh
    LV.Picture = Pic.Image
    LVZebra = True

End Function

Public Sub SortListView(ListView As ListView, ByVal Index As Integer)

    On Error Resume Next

    If Index = ListView.SortKey + 1 Then
        Dim ascending As Boolean

        If ListView.SortOrder = lvwAscending Then
            ascending = False
        Else
            ascending = True
        End If
    Else
        ascending = True
    End If

    Dim datatype As Byte

    datatype = 0

    Dim LI     As Long

    For LI = 1 To ListView.ListItems.Count

        If Index = 1 Then

            If IsNumeric(ListView.ListItems(LI).Text) Then
                datatype = 1
            ElseIf IsDate(ListView.ListItems(LI).Text) Then
                datatype = 2
            End If

        Else

            If IsNumeric(ListView.ListItems(LI).ListSubItems(Index - 1).Text) Then
                datatype = 1
            ElseIf IsDate(ListView.ListItems(LI).ListSubItems(Index - 1).Text) Then
                datatype = 2
            End If
        End If

    Next LI

    Dim I      As Integer
    Dim l      As Long
    Dim strFormat As String


    Dim lngCursor As Long
    lngCursor = ListView.MousePointer
    ListView.MousePointer = vbHourglass


    Dim blnRestoreFromTag As Boolean

    Select Case datatype
        Case 0


            blnRestoreFromTag = False

        Case 1


            strFormat = String$(20, "0") & "." & String$(10, "0")


            With ListView.ListItems
                If (Index = 1) Then
                    For l = 1 To .Count
                        With .Item(l)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsNumeric(.Text) Then
                                If CDbl(.Text) >= 0 Then
                                    .Text = Format(CDbl(.Text), strFormat)
                                Else
                                    .Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
                                End If
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(Index - 1)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsNumeric(.Text) Then
                                If CDbl(.Text) >= 0 Then
                                    .Text = Format(CDbl(.Text), strFormat)
                                Else
                                    .Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
                                End If
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                End If
            End With

            blnRestoreFromTag = True

        Case 2

            strFormat = "YYYYMMDDHhNnSs"

            Dim dte As Date

            With ListView.ListItems
                If (Index = 1) Then
                    For l = 1 To .Count
                        With .Item(l)
                            .Tag = .Text & Chr$(0) & .Tag
                            dte = CDate(.Text)
                            .Text = Format$(dte, strFormat)
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(Index - 1)
                            .Tag = .Text & Chr$(0) & .Tag
                            dte = CDate(.Text)
                            .Text = Format$(dte, strFormat)
                        End With
                    Next l
                End If
            End With

            blnRestoreFromTag = True

    End Select

    ListView.SortOrder = IIf(ascending, lvwAscending, lvwDescending)
    ListView.SortKey = Index - 1
    ListView.Sorted = True

    If blnRestoreFromTag Then
        With ListView.ListItems
            If (Index = 1) Then
                For l = 1 To .Count
                    With .Item(l)
                        I = InStr(.Tag, Chr$(0))
                        .Text = Left$(.Tag, I - 1)
                        .Tag = Mid$(.Tag, I + 1)
                    End With
                Next l
            Else
                For l = 1 To .Count
                    With .Item(l).ListSubItems(Index - 1)
                        I = InStr(.Tag, Chr$(0))
                        .Text = Left$(.Tag, I - 1)
                        .Tag = Mid$(.Tag, I + 1)
                    End With
                Next l
            End If
        End With
    End If

    ListView.MousePointer = lngCursor

End Sub
Private Function InvNumber(ByVal Number As String) As String
    Static I       As Integer
    For I = 1 To Len(Number)
        Select Case Mid$(Number, I, 1)
            Case "-": Mid$(Number, I, 1) = " "
            Case "0": Mid$(Number, I, 1) = "9"
            Case "1": Mid$(Number, I, 1) = "8"
            Case "2": Mid$(Number, I, 1) = "7"
            Case "3": Mid$(Number, I, 1) = "6"
            Case "4": Mid$(Number, I, 1) = "5"
            Case "5": Mid$(Number, I, 1) = "4"
            Case "6": Mid$(Number, I, 1) = "3"
            Case "7": Mid$(Number, I, 1) = "2"
            Case "8": Mid$(Number, I, 1) = "1"
            Case "9": Mid$(Number, I, 1) = "0"
        End Select
    Next
    InvNumber = Number

End Function


A'MoreiraEu sobrevivi ao fim do mundo (: ahahahhttp://lmgtfy.com/?q=digite+aqui+sua+duvida+que+eu+te+respondo!

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.