#1
  1. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    May 2012
    Posts
    52
    Rep Power
    3

    Basic Visual Studio Program help copying files?


    I have no knowledge of Visual Studio. I am trying to create my first program. All this program will do is let the user select the file they would like and then when they hit start it would copy the file to the network drive in a folder I specify. Where do I start?
  2. #2
  3. No Profile Picture
    Grumpier old Moderator
    Devshed Supreme Being (6500+ posts)

    Join Date
    Jun 2003
    Posts
    14,449
    Rep Power
    4539
    Look in your vb online help and locate filesystem functions and objects. Also consider using the filesystem object from the scripting library.
    ======
    Doug G
    ======
    Bartender to Rene Descartes "have another beer?" Descartes: "I think not" and he vanished.
    --Alfred Bester
  4. #3
  5. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Aug 2011
    Posts
    289
    Rep Power
    45
    The following code finds the %Temp% directory and allows the user to select a text file using a Common Dialog control. The contents of the file are loaded into a text box, and the user can then decode the contents and save the file in the location of choice. The project consists of one form and one module. The form has 1 multiline textbox with a vertical scrollbar, 3 command buttons, and 1 Common Dialog control.

    J.A. Coutts
    Code:
    **************************************************************
    Form Code
    **************************************************************
    Option Explicit
    
    Dim FileName As String
    Private Sub cmdDecode_Click()
        Text1.Text = DecodeQP(Text1.Text)
    End Sub
    
    Private Sub cmdGetFile_Click()
        Dim N%
        Dim RunFile%
        Dim TempPath As String
        Dim tmpStr As String
        TempPath = GetTmpPath
        If Len(TempPath) Then ChDir TempPath
        On Error GoTo ErrHandler
        CMDialog1.Filter = "Http Files (*.htm)|*.htm|All Files (*.*)|*.*|Text Files (*.txt)|*.txt|"
        'CMDialog1.FileName = TempPath & "*.htm"
        CMDialog1.ShowOpen
        FileName = CMDialog1.FileName
        RunFile% = OpenFile(FileName, 2, 0, 80)
        If RunFile% = 0 Then
            MsgBox FileName$ + vbCrLf + "Could not open File!"
            Exit Sub
        End If
        While Not EOF(RunFile%)
            Line Input #RunFile%, tmpStr
            Text1.Text = Text1.Text & tmpStr & vbCrLf
            N% = N% + 1
        Wend
        Close #RunFile%
        Exit Sub
    ErrHandler:
        ' User pressed Cancel button.
        Exit Sub
    End Sub
    
    Private Sub cmdSave_Click()
        Dim RunFile%
        On Error GoTo ErrHandler
        CMDialog1.Filter = "Http Files (*.htm)|*.htm|All Files (*.*)|*.*|Text Files (*.txt)|*.txt|"
        CMDialog1.FileName = FileName
        CMDialog1.ShowSave
        FileName = CMDialog1.FileName
        RunFile% = OpenFile(FileName, 1, 0, 80)
        If RunFile% = 0 Then
            MsgBox FileName + vbCrLf + "Could not open File!"
            Exit Sub
        End If
        Print #RunFile%, Text1.Text
        Close #RunFile%
        Exit Sub
    ErrHandler:
        ' User pressed Cancel button.
        Exit Sub
    End Sub
    
    
    **************************************************************
    Module Code
    **************************************************************
    Option Explicit
    Global Const MAX_PATH = 260
    Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    
    Public Function GetTmpPath() As String
        Dim sFolder As String ' Name of the folder
        Dim lRet As Long ' Return Value
        sFolder = String(MAX_PATH, 0)
        lRet = GetTempPath(MAX_PATH, sFolder)
        If lRet <> 0 Then
            GetTmpPath = Left(sFolder, InStr(sFolder, Chr(0)) - 1)
        Else
            GetTmpPath = vbNullString
        End If
    End Function
    
    Public Function DecodeQP(ByRef StrToDecode As String) As String
        Dim sTemp As String
        Dim i As Integer
        sTemp = StrToDecode
        'Delete soft end of lines
        sTemp = Replace(sTemp, "=" & Chr$(13) & Chr$(10), "")
        'Restore non ASCII chars
        For i = 255 To 127 Step -1
            If InStr(1, sTemp, "=" & Hex$(i)) <> 0 Then sTemp = Replace(sTemp, "=" & Hex$(i), Chr$(i))
        Next
        'Substitute temporary code for "=" signs
        If InStr(1, sTemp, "=" & Hex$(61)) <> 0 Then sTemp = Replace(sTemp, "=" & Hex$(61), Chr$(255) & Chr$(254))
        For i = 32 To 10 Step -1
            If InStr(1, sTemp, "=" & Hex$(i)) <> 0 Then sTemp = Replace(sTemp, "=" & Hex$(i), Chr$(i))
        Next
        'Restore control chars
        For i = 9 To 0 Step -1
            If InStr(1, sTemp, "=" & "0" & Hex$(i)) <> 0 Then sTemp = Replace(sTemp, "=" & Hex$(i), Chr$(i))
        Next
        sTemp = Replace(sTemp, "=", "") 'Replace remaining "=" signs
        sTemp = Replace(sTemp, Chr$(255) & Chr$(254), "=") 'Restore original "=" signs
        DecodeQP = sTemp
    End Function
    
    Function OpenFile(FileName$, Mode%, RLock%, RecordLen%) As Integer
      Const REPLACEFILE = 1, READAFILE = 2, ADDTOFILE = 3
      Const RANDOMFILE = 4, BINARYFILE = 5
      Const NOLOCK = 0, RDLOCK = 1, WRLOCK = 2, RWLOCK = 3
      Dim ErrorCode As Long
      Dim FileNum%, Action%, LockFlg%
      LockFlg% = 0
      FileNum% = FreeFile
      On Error GoTo OpenErrors
      Select Case Mode
        Case REPLACEFILE
            Select Case RLock%
                Case NOLOCK
                    Open FileName For Output Shared As FileNum%
                Case RDLOCK
                    Open FileName For Output Lock Read As FileNum%
                Case WRLOCK
                    Open FileName For Output Lock Write As FileNum%
                Case RWLOCK
                    Open FileName For Output Lock Read Write As FileNum%
            End Select
        Case READAFILE
            Select Case RLock%
                Case NOLOCK
                    Open FileName For Input Shared As FileNum%
                Case RDLOCK
                    Open FileName For Input Lock Read As FileNum%
                Case WRLOCK
                    Open FileName For Input Lock Write As FileNum%
                Case RWLOCK
                    Open FileName For Input Lock Read Write As FileNum%
            End Select
        Case ADDTOFILE
            Select Case RLock%
                Case NOLOCK
                    Open FileName For Append Shared As FileNum%
                Case RDLOCK
                    Open FileName For Append Lock Read As FileNum%
                Case WRLOCK
                    Open FileName For Append Lock Write As FileNum%
                Case RWLOCK
                    Open FileName For Append Lock Read Write As FileNum%
            End Select
        Case RANDOMFILE
            Select Case RLock%
                Case NOLOCK
                    Open FileName For Random Shared As FileNum% Len = RecordLen%
                Case RDLOCK
                    Open FileName For Random Lock Read As FileNum% Len = RecordLen%
                Case WRLOCK
                    Open FileName For Random Lock Write As FileNum% Len = RecordLen%
                Case RWLOCK
                    Open FileName For Random Lock Read Write As FileNum% Len = RecordLen%
            End Select
        Case BINARYFILE
            Select Case RLock%
                Case NOLOCK
                    Open FileName For Binary Shared As FileNum%
                Case RDLOCK
                    Open FileName For Binary Lock Read As FileNum%
                Case WRLOCK
                    Open FileName For Binary Lock Write As FileNum%
                Case RWLOCK
                    Open FileName For Binary Lock Read Write As FileNum%
            End Select
        Case Else
          Exit Function
      End Select
      OpenFile = FileNum%
    Exit Function
    OpenErrors:
      If Err = 70 Then  'File is locked, try 3 times
        LockFlg% = LockFlg% + 1
        Debug.Print "File Locked!"
        If LockFlg > 3 Then GoTo OpenErrCont
        Resume
      End If
    OpenErrCont:
      ErrorCode = Err
      Action% = FileErrors(ErrorCode)
      Select Case Action%
        Case 0
          Resume            'Resumes at line where ERROR occured
        Case 1
            Resume Next     'Resumes at line after ERROR
        Case 2
            OpenFile = 0     'Unrecoverable ERROR-reports error, exits function with error code
            Exit Function
        Case Else
            MsgBox Error$(Err) + vbCrLf + "After line " + Str$(Erl) + vbCrLf + "Program will TERMINATE!"
            'Unrecognized ERROR-reports error and terminates.
            End
      End Select
    End Function
    
    Function FileErrors(errVal As Long) As Integer
        Dim Msg$, msgType%, Response%
    'Return Value 0=Resume,              1=Resume Next,
    '             2=Unrecoverable Error, 3=Unrecognized Error
    msgType% = 48
    Select Case errVal
        Case 68
          Msg$ = "That device appears Unavailable."
          msgType% = msgType% + 4
        Case 71
          Msg$ = "Insert a Disk in the Drive"
        Case 53
          Msg$ = "Cannot Find File"
          msgType% = msgType% + 5
       Case 57
          Msg$ = "Internal Disk Error."
          msgType% = msgType% + 4
        Case 61
          Msg$ = "Disk is Full.  Continue?"
          msgType% = 35
        Case 64, 52
          Msg$ = "That Filename is Illegal!"
        Case 70
          Msg$ = "File in use by another user!"
          msgType% = msgType% + 5
        Case 76
          Msg$ = "Path does not Exist!"
          msgType% = msgType% + 2
        Case 54
          Msg$ = "Bad File Mode!"
        Case 55
          Msg$ = "File is Already Open."
        Case 62
          Msg$ = "Read Attempt Past End of File."
        Case Else
          FileErrors = 3
          Exit Function
      End Select
      Response% = MsgBox(Msg$, msgType%, "Disk Error")
      Select Case Response%
        Case 1, 4
          FileErrors = 0
        Case 5
          FileErrors = 1
        Case 2, 3
          FileErrors = 2
        Case Else
          FileErrors = 3
      End Select
    End Function
    
    Public Function EncodeQP(ByRef StrToEncode As String) As String
        Dim sTemp As String
        Dim i As Integer
        sTemp = StrToEncode
            For i = 255 To 127 Step -1
        If InStr(1, sTemp, Chr$(i)) <> 0 Then sTemp = Replace(sTemp, Chr$(i), "=" & Hex$(i))
        Next
        If InStr(1, sTemp, Chr$(61)) <> 0 Then sTemp = Replace(sTemp, Chr$(61), "=" & Hex$(61))
            For i = 32 To 10 Step -1
        If InStr(1, sTemp, Chr$(i)) <> 0 Then sTemp = Replace(sTemp, Chr$(i), "=" & Hex$(i))
        Next
            For i = 9 To 0 Step -1
        If InStr(1, sTemp, Chr$(i)) <> 0 Then sTemp = Replace(sTemp, Chr$(i), "=" & "0" & Hex$(i))
        Next
        EncodeQP = sTemp
    End Function

IMN logo majestic logo threadwatch logo seochat tools logo