Листинг директории

[Fiona]

Здравствуйте.
Помогите, пожалуйста разобраться, в чем причина ошибки?
В папке для импорта данных реально два файла формата xlsm. По очереди загружаются макросом в открытый пользователем шаблон, и цикл снова возвращается в папку - что за имя файла xlsm? откуда оно берется? как исключить ошибку?
А файл слетает с сообщением о сбое. В логе ошибка:
Type: com.sun.star.lang.IllegalArgumentException
Message: Unsupported URL <xlsm>: "from LoadEnv::startLoading"

[economist]

Выложите код функции
Function ReadDirectories()
...

Могу предположить что "xlsm" - 4 символа, а многие пишут код по-старинке, на 3. Надо всё проверять.

[Fiona]

Код стандартный в Tools, ничего не меняла:

Код Выделить Развернуть


Function ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean,  bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String)
Dim i as integer
Dim Status as Object
Dim FileCountinDir as Integer
Dim RealFileContent as String
Dim FileName as string
Dim oUcbObject as Object
Dim DirContent()
Dim CurIndex as Integer
Dim MaxIndex as Integer
Dim StartUbound as Integer
Dim FileExtension as String
StartUbound = 5
MaxIndex = StartUBound
CurDirMaxCount = SBMAXDIRCOUNT
Dim sFileArray(StartUbound,1) as String
On Local Error Goto FILESYSTEMPROBLEM:
CurIndex = -1
' Todo: Is the last separator valid?
DirIndex = 0
sDirArray(iDirIndex) = AnchorDir
iDirCount = 1
oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties")
oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
If oUcbObject.Exists(AnchorDir) Then
Do
AnchorDir = sDirArray(DirIndex)
On Local Error Resume Next
DirContent() = oUcbObject.GetFolderContents(AnchorDir,True)
DirIndex = DirIndex + 1
On Local Error Goto 0
On Local Error Goto FILESYSTEMPROBLEM:
If Ubound(DirContent()) <> -1 Then
FileCountinDir = Ubound(DirContent())+ 1
For i = 0 to FilecountinDir -1
If bInterruptSearch = True Then
Exit Do
End If

Filename = DirContent(i)
If oUcbObject.IsFolder(FileName) Then
If brecursive Then
AddFoldertoList(FileName, DirIndex)
End If
Else
If bcheckFileType Then
RealFileContent = GetRealFileContent(FileName)
Else
RealFileContent = GetFileNameExtension(FileName)
End If
If RealFileContent <> "" Then
' Retrieve the Index in the Array, where a Filename is positioned
If Not IsMissing(sFileContent()) Then
If (FieldInArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then
' The extension of the current file passes the filter and is therefore admitted to the
' fileList
If Not IsMissing(sExtension) Then
If sExtension <> "" Then
' Consider that some Formats like old StarOffice Templates with the extension ".vor" can only be
' precisely identified by their mimetype and their extension
FileExtension = GetFileNameExtension(FileName)
If FileExtension = sExtension Then
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If
Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If
Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If
End If
Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If
If CurIndex = MaxIndex Then
MaxIndex = MaxIndex + StartUbound
ReDim Preserve sFileArray(MaxIndex,1) as String
End If
End If
End If
Next i
End If
Loop Until DirIndex >= iDirCount
If CurIndex > -1 Then
ReDim Preserve sFileArray(CurIndex,1) as String
Else
ReDim sFileArray() as String
End If
Else
Msgbox("Directory '" & ConvertFromUrl(AnchorDir) & "' does not exist!", 16, GetProductName())
End If
ReadDirectories() = sFileArray()
Exit Function

FILESYSTEMPROBLEM:
Msgbox("Sorry, Filesystem Problem")
ReadDirectories() = sFileArray()
Resume LEAVEPROC
LEAVEPROC:
End Function

Подумала, вдруг скрытые файлы попадают в список, но их удаление тоже не помогло.

[Fiona]

Стала анализировать, что передается в массив - следующим значением шел тип файла. Переписала цикл иначе:

Код Выделить Развернуть


   FArray = ReadDirectories(PFolderName, true, true, false)
   for r = 0 to UBound(FArray)
   
      if FArray(r,0) <> "" And FArray(r,1) <> "" then
  sFileName = FArray(r,0)
        PatchFile = StarDesktop.loadComponentFromURL(sFileName,  "_blanc",0 ,NoArgs() )
        ...
      End if
   Next


Все работает, как нужно. Спасибо большое!