Private Declare Function OpenFile Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As OVERLAPPED) As Long
Private Type OVERLAPPED
ternal As Long
ternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type

Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As OVERLAPPED) As Long



Private Function OpenFiles() As Boolean
    ' îòêðûâàþ ôàéëû, çàïóñêàþ òàéìåð
    Dim ofsFrom As OFSTRUCT, ofsTo As OFSTRUCT
    boolBusy = True
    hFileFrom = OpenFile(strFromFileName, ofsFrom, OF_READ + OF_SHARE_DENY_WRITE)
    hFileTo = OpenFile(strToFileName, ofsTo, OF_WRITE + OF_SHARE_EXCLUSIVE + OF_CREATE)
    If ofsFrom.nErrCode = 0 And (ofsTo.nErrCode = 0 Or ofsTo.nErrCode = 183) Then
        lngSourceFileSize = FileLen(strFromFileName)
        lngCopyPlace = 0: lngTotalBytesCopied = 0: ReDim arrBuf(lngPackSize)
        tmrCopy.Enabled = True
        OpenFiles = True
        arrTask(lngCurTaskIndex).lngResult = 1
        PrepareProc
        SetNewTimes
        UpdateList
    Else
        lngErrorCount = lngErrorCount + 1
        ShowErr ofsTo.nErrCode, "---"
        arrTask(lngCurTaskIndex).lngResult = 3
        arrTask(lngCurTaskIndex).strErrorDescription = "Îøèáêà ïðè îòêðûòèèè ôàéëà"
        CloseHandle hFileFrom
        CloseHandle hFileTo
        boolBusy = False
        UpdateList
        NextTask
    End If
End Function

Private Sub tmrCopy_Timer()
    ' êîïèðóþ, ïîêà íå ñêîïèðóþ, çàïóñêàþ çàêðûòèå
    If boolBusy Then
        Dim nErr As Long, lngBytesToCopy As Long, lngBytesCopied As Long
        ovlFrom.offset = lngCopyPlace: lngBytesToCopy = lngPackSize
        nErr = ReadFileArr(hFileFrom, arrBuf(0), lngBytesToCopy, lngBytesCopied, ovlFrom)
        If nErr = 1 Then ' And lngBytesCopied = lngBytesToCopy
            ovlTo.offset = lngCopyPlace
            lngBytesToCopy = lngBytesCopied
            nErr = WriteFileArr(hFileTo, arrBuf(0), lngBytesToCopy, lngBytesCopied, ovlTo)
            If nErr = 1 And lngBytesCopied = lngBytesToCopy Then
                lngCopyPlace = lngCopyPlace + lngPackSize
                lngTotalBytesCopied = lngTotalBytesCopied + lngBytesCopied
'                ReDim arrBuf(lngPackSize)
                ShowProc
            Else
                Dim answer As Long
                answer = MyMsgBox("Âî âðåìÿ âûïîëíåíèÿ îïåðàöèè âîçíèêëà îøèáêà:" + vbCrLf + vbCrLf + GetErrorText(GetLastError) + vbCrLf + vbCrLf + "×òî æåëàåòå ïðåäïðèíÿòü?", _
                       "Ïðîäîëæèòü âûïîëíåíèå - ÿ èñïðàâèë ïðîáëåìó.|Ïðåðâàòü âûïîëíåíèå ýòîé çàäà÷è.|Ïðåðâàòü âûïîëíåíèå âñåõ çàäà÷.", 2, "Îøèáêà: " + CStr(GetLastError))
                Select Case answer
                    Case 0: 'Ïðîäîëæàþ...."
                    Case 1: AbortTask False
                    Case 2: AbortTask True
                End Select
                Debug.Print "Âîçíèêëà îøèáêà ïðè çàïèñè"
                Beep
            End If
        Else
            If lngSourceFileSize = lngTotalBytesCopied Then
                Debug.Print "Ñêîïèðîâàíî"
                CloseFiles
            Else
                AbortTask False
                Debug.Print "Âîçíèêëà îøèáêà ïðè ÷òåíèè"
                Beep
            End If
        End If
        UpdateTimes
    End If
End Sub


Private Function CloseFiles() As Boolean
    ' çàêðûâàþ ôàéëû, âûêëþ÷àþ òàéìåð, åñëè íàäî óäàëÿþ èñòî÷íèê,
    ' ïåðåêëþ÷àþñü íà ñëåäóþùåå çàäàíèå
    Dim nErr As Long, lngTryCount, chkRez As Boolean
    CloseHandle hFileFrom
    CloseHandle hFileTo
    tmrCopy.Enabled = False
    boolBusy = False ' ïîñëå çàêðûòèÿ ôàéëîâ, íî äî âûçîâà NextTask
    If boolNeedCheck Then chkRez = IsOk(strFromFileName, strToFileName) Else chkRez = True
    If chkRez Then
        If arrTask(lngCurTaskIndex).lngAction = 2 Then
            Do
                nErr = DeleteFile(strFromFileName)
                lngTryCount = lngTryCount + 1
                Sleep lngTryCount * 5
                If lngTryCount > 50 Then CloseHandle hFileFrom: CloseHandle hFileTo
            Loop While nErr <> 1 And lngTryCount < 100
            If nErr <> 1 Then
                arrTask(lngCurTaskIndex).lngResult = 3
                arrTask(lngCurTaskIndex).strErrorDescription = "&#205;&#229; &#243;&#228;&#224;&#235;&#238;&#241;&#252; &#243;&#228;&#224;&#235;&#232;&#242;&#252; &#244;&#224;&#233;&#235; &#239;&#238;&#241;&#235;&#229; &#234;&#238;&#239;&#232;&#240;&#238;&#226;&#224;&#237;&#232;&#255;"
            End If
        End If
        If nErr = 0 Then arrTask(lngCurTaskIndex).lngResult = 2
    Else
        With arrTask(lngCurTaskIndex)
            If .lngResult = 4 Then
                .strDetails = "&#207;&#240;&#229;&#240;&#226;&#224;&#237;&#238; &#239;&#238;&#235;&#252;&#231;&#238;&#226;&#224;&#242;&#229;&#235;&#229;&#236;"
            Else
                .lngResult = 3
                .strErrorDescription = "&#200;&#241;&#245;&#238;&#228;&#237;&#251;&#233; &#232; &#234;&#238;&#237;&#229;&#247;&#237;&#251;&#233; &#244;&#224;&#233;&#235;&#251; &#237;&#229;&#238;&#228;&#232;&#237;&#224;&#234;&#238;&#226;&#251;"
            End If
        End With
    End If
    UpdateList
    NextTask
End Function

dim ff as long
ff = freefile
open "FileName.txt" for output as ff
    print #ff, myvar
close(ff)