I have an agent to list and remove files on a Domino temp folder:
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Print "-- running from db " + db.Notesurl
Set filelist = New HandleFilesInDirectory("D:\IBM\Domino\Temp\notes53F5BD\xspupload\")
'Set filelist = New HandleFilesInDirectory("D:\IBM\Domino\Temp\notes53F5BD\")
Call filelist.GetFilesOnDisk()
'%REM
Print "Directory List Starts"
ForAll x In filelist.m_SumDirs
Print ListTag(x)
End ForAll
'%END REM
'%REM
Print "File List Starts"
ForAll y In filelist.m_SumFiles
Print ListTag(y)
Kill y
End ForAll
'%END REM
Call filelist.EraseListFromMemory()
End Sub
Scriptlibrary:
%REM
Class HandleFilesInDirectory
Description: Comments for Class
%END REM
Public Class HandleFilesInDirectory
Private m_session As NotesSession
Private m_DirectoryStart As String
Public m_SumDirs List As String
Public m_SumFiles List As String
Public Sub New (DirectoryStart As String)
Set me.m_session = New NotesSession
me.m_DirectoryStart = DirectoryStart
End Sub
%REM
Sub GetFilesOnDisk
Description: Comments for Sub
%END REM
Public Sub GetFilesOnDisk()
Call me.ScanDirs(me.m_DirectoryStart)
End Sub
%REM
Sub ScanDirs
Description: Comments for Sub
%END REM
Private Sub ScanDirs(path As String)
Dim sess As New NotesSession
Dim DirList As Variant
Dim filename As String
Dim filepath As String
Dim sep As String
If path <> "" Then
If InStr(sess.Platform, "Windows") > 0 Then
sep = "\"
Else
sep = "/"
End If
ReDim DirList(0)
If InStr(path, sep) > 0 Then
filepath = StrLeftBack(path, sep)
End If
filename = Dir(path, 16)
While filename <> ""
If filename <> "." And filename <> ".." Then
If (GetFileAttr(filepath & sep & filename) And 16) >0 Then
DirList = ArrayAppend(DirList,filepath & sep & filename & sep)
m_SumDirs(filepath & sep & filename & sep) = "Yes"
Else
' PERFORM DESIRED CHECK/OPERATION
' ON filepath & sep & filename
' OR filename (as desired)
m_SumFiles(filepath & sep & filename) = "Yes"
End If
End If
filename = Dir
Wend
DirList = FullTrim(DirList)
ForAll dirpath In DirList
ScanDirs(dirpath)
End ForAll
End If
End Sub
%REM
Sub EraseListFromMemory
Description: Comments for Sub
%END REM
Public Sub EraseListFromMemory()
Erase m_SumDirs
Erase m_SumFiles
End Sub
End Class
which returns the following output:
[02D4:0002-0C68] 2019-09-24 16:19:19 AMgr: Agent ('GetMyFiles' in 'KKom\patrick\app.nsf') printing: D:\IBM\Domino\Temp\notes53F5BD\xspupload\placeholder.txt
[02D4:0002-0C68] 2019-09-24 16:19:19 AMgr: Agent ('GetMyFiles' in 'KKom\patrick\app.nsf') error message: Path/file access error
The agent is signed proper ID and runtime security level is set to 3
Can someone explain what I do incorrect?
Related
I have a text document with a list of file names and their extensions. I need to go through this list and check a directory for the existence of each file. I then need to output the result to either foundFilesList.txt or OrphanedFiles.txt. I have two approaches to this function, and neither is working. The first example uses a loop to cycle through the text doc. The second one doesn't work it never sees a match for the file from the fileNamesList.
Thank you for taking the time to look at this.
First Code:
Dim FILE_NAME As String
FILE_NAME = txtFileName.Text
Dim fileNames = System.IO.File.ReadAllLines(FILE_NAME)
fCount = 0
For i = 0 To fileNames.Count() - 1
Dim fileName = fileNames(i)
'sFileToFind = location & "\" & fileName & "*.*"
Dim paths = IO.Directory.GetFiles(location, fileName, IO.SearchOption.AllDirectories)
If Not paths.Any() Then
System.IO.File.AppendAllText(orphanedFiles, fileName & vbNewLine)
Else
For Each pathAndFileName As String In paths
If System.IO.File.Exists(pathAndFileName) = True Then
Dim sRegLast = pathAndFileName.Substring(pathAndFileName.LastIndexOf("\") + 1)
Dim toFileLoc = System.IO.Path.Combine(createXMLFldr, sRegLast)
Dim moveToFolder = System.IO.Path.Combine(MoveLocation, "XML files", sRegLast)
'if toFileLoc = XML file exists move it into the XML files folder
If System.IO.File.Exists(toFileLoc) = False Then
System.IO.File.Copy(pathAndFileName, moveToFolder, True)
System.IO.File.AppendAllText(ListofFiles, sRegLast & vbNewLine)
fileFilename = (fileName) + vbCrLf
fCount = fCount + 1
BackgroundWorker1.ReportProgress(fCount)
'fileCount.Text = fCount
End If
End If
Next
End If
BackgroundWorker1.ReportProgress(100 * i / fileNames.Count())
'statusText = i & " of " & fileName.Count() & " copied"
fCount = i
Next
Second Code:
FILE_NAME = txtFileName.Text 'textfield with lines of filenames are located ]
Dim fileNamesList = System.IO.File.ReadAllLines(FILE_NAME)
location = txtFolderPath.Text
fCount = 0
' Two list to collect missing and found files
Dim foundFiles As List(Of String) = New List(Of String)()
Dim notfoundFiles As List(Of String) = New List(Of String)()
Dim fileNames As String() = System.IO.Directory.GetFiles(createXMLFldr)
For Each file As String In fileNamesList
Debug.Write("single file : " & file & vbCr)
' Check if the files is contained or not in the request list
Dim paths = IO.Directory.GetFiles(location, file, IO.SearchOption.AllDirectories)
If fileNamesList.Contains(Path.GetFileNameWithoutExtension(file)) Then
Dim FileNameOnly = Path.GetFileName(file)
Debug.Write("FileNameOnly " & FileNameOnly & vbCr)
If System.IO.File.Exists(FileNameOnly) = True Then
'if toFileLoc = XML file exists move it into the XML files folder
Dim moveToFolder = System.IO.Path.Combine(MoveLocation, "XML files", file)
foundFiles.Add(file) 'add to foundFiles list
fileFilename = (file) + vbCrLf 'add file name to listbox
fCount = fCount + 1
Else
notfoundFiles.Add(file)
End If
End If
Next
File.WriteAllLines(ListofFiles, foundFiles)
File.WriteAllLines(orphanedFiles, notfoundFiles)
This is just a starting point for you, but give it a try:
Friend Module Main
Public Sub Main()
Dim oFiles As List(Of String)
Dim _
sOrphanedFiles,
sSearchFolder,
sFoundFiles,
sTargetFile As String
sOrphanedFiles = "D:\Results\OrphanedFiles.txt"
sSearchFolder = "D:\Files"
sFoundFiles = "D:\Results\FoundFiles.txt"
oFiles = IO.File.ReadAllLines("D:\List.txt").ToList
oFiles.ForEach(Sub(File)
If IO.Directory.GetFiles(sSearchFolder, File, IO.SearchOption.AllDirectories).Any Then
sTargetFile = sFoundFiles
Else
sTargetFile = sOrphanedFiles
End If
IO.File.AppendAllText(sTargetFile, $"{File}{Environment.NewLine}")
End Sub)
End Sub
End Module
If I've misjudged the requirements, let me know and I'll update accordingly.
Explanations and comments in-line.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'I presume txtFileName.Text contains the full path including the file name
'I also presume that this text file contains only file names with extensions
Dim FilesInTextFile = System.IO.File.ReadAllLines(txtFileName.Text)
'Instead of accessing the Directory over and over, just get an array of all the files into memory
'This should be faster than searching the Directory structure one by one
'Replace <DirectoryPathToSearch> with the actual path of the Directory you want to search
Dim FilesInDirectory = IO.Directory.GetFiles("<DirectoryPathToSearch>", "*.*", IO.SearchOption.AllDirectories)
'We now have an array of full path and file names but we just need the file name for comparison
Dim FileNamesInDirectory = From p In FilesInDirectory
Select Path.GetFileName(p)
'A string builder is more efficient than reassigning a string with &= because a
'string build is mutable
Dim sbFound As New StringBuilder
Dim sbOrphan As New StringBuilder
'Instead of opening a file, writing to the file and closing the file
'in the loop, just append to the string builder
For Each f In FilesInTextFile
If FileNamesInDirectory.Contains(f) Then
sbFound.AppendLine(f)
Else
sbOrphan.AppendLine(f)
End If
Next
'After the loop write to the files just once.
'Replace the file path with the actual path you want to use
IO.File.AppendAllText("C:\FoundFiles.txt", sbFound.ToString)
IO.File.AppendAllText("C:\OrphanFiles.txt", sbOrphan.ToString)
End Sub
This is driving us crazy, this should work!
When ran (Stepping)
It jumps over the debug.print (No Errors)
Then it hits i += 1
Never stops at the next (break point)
But i=51 !
Any Clues
If CheckBox8.Checked = False Then
Exit Function
Else
Dim fInfo As FileInfo()
Dim i As Integer = 0
Dim dInfo As DirectoryInfo = New DirectoryInfo(spath.ToString)
fInfo = dInfo.GetFiles("*.xml")
Dim sfiles As String()
Dim sFile As String
sfiles = Directory.GetFiles(spath, "*.xml")
For Each sFile In sfiles
Try
Debug.Print(sFile.ToString)
i += 1
Catch ex As Exception
Debug.Print(ex.Message)
End Try
Next
End If
This code appears to work correctly
Imports System.IO
Module Module1
Sub Main()
Dim spath As String
spath = "C:\YOUR_DIRECTORY"
Dim fInfo As FileInfo()
Dim i As Integer = 0
Dim dInfo As DirectoryInfo = New DirectoryInfo(spath.ToString)
Try
fInfo = dInfo.GetFiles("*.xml")
For Each fi In dInfo.GetFiles("*.xml")
Dim file_name As String
file_name = fi.Name
Console.WriteLine(file_name)
i = i + 1
Next
Console.WriteLine("Found:" + i.ToString + " Files")
Catch ex As Exception
Console.Write(ex.Message)
End Try
End Sub
End Module
Note: Debug.Print will print to the "Output Window" in Visual Studio, Not the command line, so..... the Debug.Print statements might not be entirely obvious if you dont have the output window open.
TortoiseSVN provides a COM interface for retrieving information about a file.
Using VBA, I can get information about a file in the SVN repository by doing this:
Public Function getSvnURL(ByVal fullFilename As String)
Dim oSvn As Object
Set oSvn = CreateObject("SubWCRev.Object")
oSvn.GetWCInfo fullFilename, 1, 1
getSvnURL = oSvn.url
End Function
If I have an SVN revision number however, is there an API I can use to get the files that were part of that commit? Something like:
Public Function getFilesInRevision(revisionNumber As Integer) as Collection
Dim oSvn As Object
Set oSvn = CreateObject("SubWCRev.Object")
oSvn.GetWCInfo revisionNumber
getFilesInRevision= oSvn.fileList
End Function
I ended up using the following method:
Public Function getFilesForRevision(revisionNumber As Long, folder As String) As Collection
Dim command As String
command = "svn log -v -q -r " & revisionNumber & " " & folder
Dim rawText As String
rawText = ShellRun(command)
Dim lines() As String
lines = Split(rawText, vbLf)
Set getFilesForRevision = New Collection
Dim filenameRegex As Object
Set filenameRegex = CreateObject("VBScript.RegExp")
filenameRegex.Pattern = "\s{3}.\s(.*)"
Dim line As Variant
For Each line In lines
If filenameRegex.test(line) Then
getFilesForRevision.Add (filenameRegex.Execute(line).Item(0).submatches(0))
End If
Next line
End Function
Which relies on this method to run the command and store the console output:
'http://stackoverflow.com/questions/2784367/capture-output-value-from-a-shell-command-in-vba
Public Function ShellRun(sCmd As String) As String
'Run a shell command, returning the output as a string'
Dim oShell As Object
Set oShell = CreateObject("WScript.Shell")
'run command'
Dim oExec As Object
Dim oOutput As Object
Set oExec = oShell.Exec(sCmd)
Set oOutput = oExec.StdOut
'handle the results as they are written to and read from the StdOut object'
Dim s As String
Dim sLine As String
While Not oOutput.AtEndOfStream
sLine = oOutput.ReadLine
If sLine <> "" Then s = s & sLine & vbCrLf
Wend
ShellRun = s
End Function
Which can be called like this:
Sub getFilesForRevisionTest()
Dim files As Collection
Set files = getFilesForRevision(111041, "C:\SVN\")
Dim fullFilename As Variant
For Each fullFilename In files
Debug.Print fullFilename
Next fullFilename
End Sub
There is this database program that I am working on. For some reason the boss purchased all 64bit 2010 Office Suites so I am updating the program to work on the 64bit Office.
In this section I have a problem with trying to figure out the way to make this work on 64bit Access. I can't seem to get a straight answer about msaof, nor can I find any work that has the updated code. Its part of the Northwind Refresh Table Link which can be found on the internet but code only works in 32bit.
Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the friendly MSAccess structure to the win32 structure.
Dim strFile As String * 512
' Initialize some parts of the structure.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile & String$(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String$(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub
One of thing is that I get the error "of.nMaxCustrFilter = 0" does not exist but when I comment it out the debugger still points to it and Highlights the entire first line.
Update:This is the entire code
Option Explicit ' Require variables to be declared before being used.
Option Compare Database ' Use database order for string comparisons.
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Type MSA_OPENFILENAME
' Filter string used for the File Open dialog filters.
' Use MSA_CreateFilterString() to create this.
' Default = All Files, *.*
strFilter As String
' Initial Filter to display.
' Default = 1.
lngFilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
strInitialDir As String
' Initial file name to populate the dialog with.
' Default = "".
strInitialFile As String
strDialogTitle As String
' Default extension to append to file if user didn't specify one.
' Default = System Values (Open File, Save File).
strDefaultExtension As String
' Flags (see constant list) to be used.
' Default = no flags.
lngFlags As Long
' Full path of file picked. On OpenFile, if the user picks a
' nonexistent file, only the text in the "File Name" box is returned.
strFullPathReturned As String
' File name of file picked.
strFileNameReturned As String
' Offset in full path (strFullPathReturned) where the file name
' (strFileNameReturned) begins.
intFileOffset As Integer
' Offset in full path (strFullPathReturned) where the file extension begins.
intFileExtension As Integer
End Type
Const ALLFILES = "All Files"
Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As LongPtr
lpTemplateName As String
End Type
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10
Function FindNorthwind(strSearchPath) As String
' Displays the open file dialog box for the user to locate
' the ElectricData database. Returns the full path to ElectricData.
Dim msaof As MSA_OPENFILENAME
' Set options for the dialog box.
msaof.strDialogTitle = "Where Is ElectricData.accdb?"
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString("Databases", "**.accdb")
' Call the Open File dialog routine.
MSA_GetOpenFileName msaof
' Return the path and file name.
FindNorthwind = Trim(msaof.strFullPathReturned)
End Function
Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Creates a filter string from the passed in arguments.
' Returns "" if no args are passed in.
' Expects an even number of args (filter name, extension), but
' if an odd number is passed in, it appends *.*
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function
Function MSA_ConvertFilterString(strFilterIn As String) As String
' Creates a filter string from a bar ("|") separated string.
' The string should pairs of filter|extension strings, i.e. "Access Databases|**.accdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the strings passed in is empty.
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
' Add strings as long as we find bars.
' Ignore any empty strings (not allowed).
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
' Get last string if it exists (assuming strFilterIn was not bar terminated).
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
' Add *.* if there's no extension for the last string.
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
' Add terminating NULL if we have any filter.
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function
Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file save dialog.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function
Function MSA_SimpleGetSaveFileName() As String
' Opens the file save dialog with default values.
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function
Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file open dialog.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function
Function MSA_SimpleGetOpenFileName() As String
' Opens the file open dialog with default values.
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetOpenFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetOpenFileName = strRet
End Function
Public Function CheckLinks() As Boolean
' Check links to the ElectricData database; returns true if links are OK.
Dim dbs As Database, rst As DAO.Recordset
Set dbs = CurrentDb()
' Open linked table to see if connection information is correct.
On Error Resume Next
Set rst = dbs.OpenRecordset("lstPartClasses")
' If there's no error, return True.
If Err = 0 Then
CheckLinks = True
Else
CheckLinks = False
End If
End Function
Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' This sub converts from the win32 structure to the friendly MSAccess structure.
msaof.strFullPathReturned = Left$(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub
Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the friendly MSAccess structure to the win32 structure.
Dim strFile As String * 512
' Initialize some parts of the structure.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile & String$(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String$(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub
Private Function RefreshLinks(strFilename As String) As Boolean
' Refresh links to the supplied database. Return True if successful.
Dim dbs As Database
Dim intCount As Integer
Dim tdf As TableDef
' Loop through all tables in the database.
Set dbs = CurrentDb
For intCount = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intCount)
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strFilename
' Debug.Print tdf.Connect
' Debug.Print tdf.SourceTableName
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
RefreshLinks = False
Exit Function
End If
End If
Next intCount
RefreshLinks = True ' Relinking complete.
End Function
Public Function RelinkTables() As Boolean
' Tries to refresh the links to the American Campus IT Department database.
' Returns True if successful.
Const conMaxTables = 8
Const conNonExistentTable = 3011
Const conNotNorthwind = 3078
Const conNwindNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conAppTitle = "Calvin's Electric - Bid/Job Program"
Dim strAccDir As String
Dim strSearchPath As String
Dim strFilename As String
Dim intError As Integer
Dim strError As String
' Get name of directory where Msaccess.exe is located.
strAccDir = SysCmd(acSysCmdAccessDir)
' Get the default sample database path.
If Dir(strAccDir & "\.") = "" Then
strSearchPath = strAccDir
Else
strSearchPath = strAccDir & "\"
End If
' Look for the ElectricData database.
If (Dir(strSearchPath & "ElectricData.accdb") <> "") Then
strFilename = strSearchPath & "ElectricData.accdb"
Else
' Can't find ElectricData, so display the File Open dialog.
MsgBox "Can't find linked tables in the Calvin's Electric Bid And Job Program. You must locate the ElectricData Database in order to use " _
& conAppTitle & ".", vbExclamation
strFilename = FindNorthwind(strSearchPath)
If strFilename = "" Then
strError = "Sorry, you must locate ElectricData.accdb to open " & conAppTitle & "."
GoTo Exit_Failed
End If
End If
' Fix the links.
If RefreshLinks(strFilename) Then ' It worked!
RelinkTables = True
Exit Function
End If
' If it failed, display an error.
Select Case Err
Case conNonExistentTable, conNotNorthwind
strError = "File '" & strFilename & "' does not contain the required ElectricData tables."
Case Err = conNwindNotFound
strError = "You can't run " & conAppTitle & " until you locate the ElectricData database."
Case Err = conAccessDenied
strError = "Couldn't open " & strFilename & " because it is read-only or located on a read-only share."
Case Err = conReadOnlyDatabase
strError = "Can't reattach tables because " & conAppTitle & " is read-only or is located on a read-only share."
Case Else
strError = Err.Description
End Select
Exit_Failed:
MsgBox strError, vbCritical
RelinkTables = False
End Function
As an alternative to messing around with the 32/64-bit API declarations, you could just use the Application.FileDialog method that is available in Access 2010. It works with both the 32-bit and 64-bit versions of Access.
It seems likely that you have Declare Function somewhere that need to read Declare PtrSafe Function. Then you will have to make sure that you have a 64 bit library for the DLL you are calling. It seems (not well tested) to work fine in my 64 bit application using the code here http://www.dbforums.com/microsoft-access/990945-building-database-help.html.
I want to list all files in a subdirectory on istostorage
Public Function GetAllFilesInDirectory(ByVal DirectoryName As String) As List(Of String)
Dim isoStore As IsolatedStorageFile = IsolatedStorageFile.GetUserStoreForApplication()
Dim L As New List(Of String)
For Each di As String In isoStore.GetDirectoryNames
If di = DirectoryName Or di & "/" = DirectoryName Then
For Each fi As String In isoStore.GetFileNames'<-- fails because not the subdirectory is listed
If fi.StartsWith(DirectoryName) Then L.Add(fi)
Next
End If
Next
Return L
End Function
I'm not a VB.NET developer, so I used a converter to convert from my old C# version. See if this helps read all directories:
Public Shared Sub GetIsolatedStorageView(pattern As String, storeFile As IsolatedStorageFile)
Dim root As String = System.IO.Path.GetDirectoryName(pattern)
If root <> "" Then
root += "/"
End If
Dim directories As String() = storeFile.GetDirectoryNames(pattern)
'if the root directory has no FOLDERS, then the GetFiles() method won't be called.
'the line below calls the GetFiles() method in this event so files are displayed
'even if there are no folders
If directories.Length = 0 Then
GetFiles(root, "*", storeFile)
End If
For i As Integer = 0 To directories.Length - 1
Dim dir As String = directories(i) + "/"
'Write to output window
Debug.WriteLine(root + directories(i))
'Get all the files from this directory
GetFiles(root + directories(i), pattern, storeFile)
'Continue to get the next directory
GetIsolatedStorageView(root + dir + "*", storeFile)
Next
End Sub
Private Shared Sub GetFiles(dir As String, pattern As String, storeFile As IsolatedStorageFile)
Dim fileString As String = System.IO.Path.GetFileName(pattern)
Dim files As String() = storeFile.GetFileNames(pattern)
Try
For i As Integer = 0 To storeFile.GetFileNames(dir + "/" + fileString).Length - 1
'Files are prefixed with "--"
Debug.WriteLine("--" + dir + "/" + storeFile.GetFileNames(dir + "/" + fileString)(i))
Next
Catch ise As IsolatedStorageException
Debug.WriteLine("An IsolatedStorageException exception has occurred: " + ise.InnerException)
Catch e As Exception
Debug.WriteLine("An exception has occurred: " + e.InnerException)
End Try
End Sub
If you want it for development purposes, you could use the wp7explorer tool instead.