Не могу написать в камеру. Всегда ошибка времени выполнения '1004' - PullRequest
Новая
       2

Не могу написать в камеру. Всегда ошибка времени выполнения '1004'

0 голосов
/ 10 января 2020

Всегда получаю ошибку времени выполнения «1004» при попытке записи в ячейку. Я хочу написать макрос, который выбирает пути к файлам из папки и обрезает их, а после этого записывает их в ячейку. Кроме того, я хочу проверить, ячейка пуста или нет, потому что не хочу удалять какие-либо важные данные. Каждый раз, когда я использую ячейки, я не могу получить доступ к ячейке, и я не знаю, почему .. 

Sub LOGGERTESTER()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim currentRow As Long, currentColumn As Long
Dim valueAdded As Boolean
Dim filenamesArray As Variant
Dim entity As String

entity = "9999"
currentRow = 0

filenamesArray = getFiles("C:\Users\egy.szepgyerek\Desktop\PO DATA LOGGER TEST\Test Folder")

For Each currentPath In filenamesArray
    If EndsWith(CStr(currentPath), ".pdf") And Not EndsWith(CStr(currentPath), "backup.pdf") Then
        pieces = Split(currentPath, "_")
        currentColumn = 0
        dateNow = Format(Now(), "yyyy-MM-dd")
        With Sheets(1)
                .Unprotect
                If IsEmpty(.Cells(currentRow, currentColumn).Value) = True Then
                    .Cells(currentRow, currentColumn).Value = dateNow
                    .Cells(currentRow, currentColumn).Value = entity
                    valueAdded = True
                    currentColumn = currentColumn + 1
                Else
                    valueAdded = False
                    currentRow = currentRow + 1
                End If
        End With
    End If
Next

'This is working I dont know why
'For currentRow = 1 To 4
'    For currentColumn = 1 To 10
'        With Sheets(1)
'            valueAdded = False
'            Do While valueAdded = False
'                If IsEmpty(.Cells(currentRow, currentColumn).Value) = True Then
'                    .Cells(currentRow, currentColumn).Value = 0
'                    valueAdded = True
'                Else
'                    valueAdded = False
'                    currentRow = currentRow + 1
'               End If
'            Loop
'        End With
'    Next
'Next
Application.ScreenUpdating = True
End Sub
Function getFiles(ByVal sPath As String)
With Sheets(1)
    Dim resultArray     As Variant
    Dim i           As Integer
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim resultArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        resultArray(i) = oFile.Name
        i = i + 1
    Next

    getFiles = resultArray
End With
End Function
Public Function EndsWith(str As String, ending As String) As Boolean
With Sheets(1)
     Dim endingLen As Integer
     endingLen = Len(ending)
     EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End With
End Function
...