I need help in a VBA macro that'll delete files in a directory that contains more than 2 "_" and is older than 3 months old, however there are some folders & sub folders in the directory that must not be touched or modified.
E.g, Hi_Thanks_for_your_help or Hi_Thank_You etc.
Const DIR = "x"
Const MAX_AGE = 3 ' Unit: Months
Dim oFSO
Dim aExclude
Sub XLS()
aExclude = Array("x")
Set oFSO = CreateObject("Scripting.FilesystemObject")
deleteFiles oFSO.GetFolder(DIR)
Set oFSO = Nothing
End Sub
'=================================
Function isExclude(sPath)
Dim s, bAns
bAns = False
For Each s In aExclude
If InStr(1, sPath, s, vbTextCompare) = 1 Then
bAns = True
Exit For
End If
Next
isExclude = bAns
End Function
'=================================
Function isOldFile(fFile)
' Old file if "MAX_AGE" months before today is greater than the file modification time
isOldFile = (DateAdd("m", -MAX_AGE, Date) > fFile.DateLastModified)
End Function
This is the furthest i got with a code, what i'm lacking is how to check if a file name consists more than 2 "_" and if so & it's older than 3 months old = delete.
Thanks in advance! Cheers!
Dim pathname As String = ""
If fileNameCount("file_name") And DateDiff("m", NOW(), FileDateTime(pathname)) > 3 Then ' if '_' is more than 2 count and more than 3 months old, then delete
' if true delete file codes starts here
......
End If
Public Function fileNameCount(filename As String) As Boolean
fileNameCount = False
Dim count As Long
Dim temp() As String
temp = Split(filename, "_")
count = UBound(temp, 1)
If (count > 2) Then
fileNameCount = True
End If
End Function
I have written portion of the codes for you, the method fileNameCount will return you true / false for number of counts of '_', I'm using DateDiff to get the difference of the month of the file. Therefore I'm detecting on the both conditions, if both statement are true condition then you should proceed on with your deletion of file codes which I didn't write for that.
What you need to do is
1) Pass in the "file_name" argument which you need to think on how to get the file name
2) Pass in the right pathname of the file
3) Write the code for deletion of files
Anyway, I didn't test out the code so it might have some error(s). Hope this will help what you're trying to do.
To get the amount of "_" in a file, I would use something similar to this:
Dim a
Dim c As Integer
a = Split("File_Name_Here", "_")
c = Ubound(a)
Using this, you know that if the filename gets split into 3 or more substrings, there were 2 "_" in the filename. As for the age of the file, FileDateTime("FilePath") will get you the created date or the last modified date.
Related
I have a folder with 700+ .jpgs. I also have a Textbox with one filename per line.
I want to check which file does not exist in the folder, but should be there.
This is my code:
Dim Counter As Integer = 0
For Each Line As String In tbFileNames.Lines
Counter = Counter + 1
If (IO.File.Exists(tbFolder.Text & "\" & tbFileNames.Lines(Counter - 1).ToString & ".jpg")) = False Then
tbNotExistingFiles.Text = tbNotExistingFiles.Text & vbNewLine & (tbFileNames.Lines(Counter - 1).ToString)
Else
End If
Next
Problem: I get more than 300 "missing" files, but there should be only 7. When I search for the output filenames, they are in the folder, so the FileExists functions returns false, but it shouldn't.
Where is the problem? Is it the amount of files?
According to this line:
If (IO.File.Exists(tbFolder.Text & "\" & tbFileNames.Lines(Counter - 1).ToString & ".jpg")) = False
Which can be interpreted as:
The tbFolder TextBox contains the directory's path where the images are located.
The tbFileNames TextBox contains the main and complete file names. One file name per line.
Appending the extension & ".jpg" means that the file names in the tbFileNames TextBox are without extensions. And,
You need to get a list of the missing files in that directory and show the result in the tbNotExistingFiles TextBox.
If my interpretation is correct, then you can achieve that using the extension methods like:
Imports System.IO
'...
Dim missingFiles = tbFileNames.Lines.
Select(Function(x) $"{x.ToLower}.jpg").
Except(Directory.GetFiles(tbFolder.Text).
Select(Function(x) Path.GetFileName(x.ToLower)))
tbNotExistingFiles.Text = String.Join(ControlChars.NewLine, missingFiles)
Or by a LINQ query:
Dim missingFiles = From x In tbFileNames.Lines
Where (
Aggregate y In Directory.EnumerateFiles(tbFolder.Text)
Where Path.GetFileName(y).ToLower.Equals($"{x.ToLower}.jpg")
Into Count()
) = 0
Select x
'Alternative to tbNotExistingFiles.Text = ...
tbNotExistingFiles.Lines = missingFiles.ToArray
Note that, there's no need nor use for the File.Exists(..) function in the preceding snippets. Just in case you prefer your approach using For..Loop and File.Exists(..) function, then you can do:
Dim missingFiles As New List(Of String)
For Each line In tbFileNames.Lines
If Not File.Exists(Path.Combine(tbFolder.Text, $"{line}.jpg")) Then
missingFiles.Add(line)
End If
Next
tbNotExistingFiles.Lines = missingFiles.ToArray
I have been trying to figure out a way to, after performing a mail merge, separate the documents into individual ones and name them after a specific item, preferably the first line of the header. I have only been able to find ways to split the document, but cannot figure out how to name it. Any help with how to write the VBA code to save a document as the header would be very much appreciated.
Since you already separated the documents, the code below might give them names using their first sentence.
Private Function DocName(Doc As Document) As String
' 23 Aug 2017
Const Illegals As String = "\:/;?*|>"""
Static FaultCounter As Integer
Dim Fun As String
Dim Title As String
Dim Ch As String
Dim i As Integer
Title = Trim(Doc.Sentences(1))
For i = 1 To Len(Title)
Ch = Mid(Title, i, 1)
If (Asc(Ch) > 31) And (Asc(Ch) < 129) Then
If InStr(Illegals, Ch) = 0 Then Fun = Fun & Ch
End If
Next i
If Len(Fun) = 0 Then
FaultCounter = FaultCounter + 1
Fun = Format(FaultCounter, """Default File Name (""0"")""")
End If
DocName = Fun
End Function
Before saving the file you might want to check for duplicates. Use the Dir() function for that and add a number to duplicate names using the system I included above to name files where the first sentence might be empty.
You may also have to review the characters which aren't permitted in file names. I have simply excluded all below ASCII(32) and above ASCII(128), and then the known ones Windows doesn't like. You might want to modify that range further.
To call the above function use code like this:-
Private Sub GetName()
Debug.Print DocName(ActiveDocument)
End Sub
This is the code I have so far, I was able to find it off of a very helpful website, but the code saves as the word "report" which I set it to right now while I'm trying to figure it out, and then the number of the document.
Option Explicit
Sub splitter()
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmergeas
a separate file.
Application.ScreenUpdating = False
Dim Program As String
Dim DocName As String
Dim Letters As Integer, Counter As Integer
Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
'program = ActiveDocument.MailMerge.DataSource.DataFields("Program_Outcomes_PlanReport_Name").Value
DocName = "Reports" & LTrim$(Str$(Counter)) 'Generic name of document
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
ActiveDocument.SaveAs filename:="E:\assessment rubrics\Templates" & "\" & DocName, FileFormat:=wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveWindow.Close
Counter = Counter + 1
Wend
Application.ScreenUpdating = True
End Sub
I need some help with my excel vba.
First of all let me tell what it should do...
On a network folder there are pdf-files which should be count.
Folders look like this:
X:/Tests/Manufact/Prod_1/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
X:/Tests/Manufact/Prod_2/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
X:/Tests/Manufact/Prod_3/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
Also there is a folder for each year and for each month, where the pdfs are sorted based on their date of creation.
The files counted should be listed in the active sheet as a list with filename and date.
After that I want to count how many pdf-files were created on a specific day between a given time. Should be in a new sheet like
Date - Time-Period 1 (0AM-6AM) - Time Period 2 (6AM-10AM) - Time Period 3 (10AM - 12AM)
01.01.2017 - 12PDFs - 17PDFs - 11PDFs
02.01.2017 - 19PDFs - 21PDFs - 5PDFs
Maybe there is also a way of memory, so the script does not count all the files again which were already listed before? (Cause there are more than 100k pdfs and it's increasing everyday...)
So... I searched a whole week on the internet for solutions, and I found a few, ending me up with this code:
Sub ListFiles()
Const sRoot As String = "X:\Tests\Manufact\"
Dim t As Date
Application.ScreenUpdating = False
With Columns("A:E")
.ClearContents
.Rows(1).Value = Split("File,Date,Day,Time,Size", ",")
End With
t = Timer
NoCursing sRoot
Columns.AutoFit
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.0s")
End Sub
Sub NoCursing(ByVal sPath As String)
Const iAttr As Long = vbNormal + vbReadOnly + _
vbHidden + vbSystem + _
vbDirectory
Dim col As Collection
Dim iRow As Long
Dim jAttr As Long
Dim sFile As String
Dim sName As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Set col = New Collection
col.Add sPath
iRow = 1
Do While col.count
sPath = col(1)
sFile = Dir(sPath, iAttr)
Do While Len(sFile)
sName = sPath & sFile
On Error Resume Next
jAttr = GetAttr(sName)
If Err.Number Then
Debug.Print sName
Err.Clear
Else
If jAttr And vbDirectory Then
If Right(sName, 1) <> "." Then col.Add sName & "\"
Else
iRow = iRow + 1
If (iRow And &HFFF) = 0 Then Debug.Print iRow
Rows(iRow).Range("A1:E1").Value = Array(sName, _
FileDateTime(sName), _
FileDateTime(sName), _
FileDateTime(sName), _
FileLen(sName))
End If
End If
sFile = Dir()
Loop
col.Remove 1
Loop
End Sub
What it does is counting ALL files in the directorys (So there is something missing telling it to only count PDFs).
It does list the files in my sheet, I'm happy with that part, but it only lists it. I still need the sorting part, so either only let it count day and time period, or let it count/list everything first and afterwards sort and count only the day and time period from the list (I really don't know which one would be better, maybe there is an easy way and a hard one?)
So if any one has a clue how to do that, please let me know, I'm thankful for any help!
Best Regards - Jan
OK I just worked on a similar project not to long ago. I am going to assume something here and you tell me if anything will break the whole system.
1) We can and are allowed to move .PDF files to a sub folder after we process it, or
2) We can and are allowed to rename (even temporary) .PDF files.
3) If we pass a month we do not need to process it any longer, for example today we are in February of 2017, so we stopped processing January 2017 files.
If we can and are allowed to proceed with these assumptions, then to lessen the double work, once a .PDF is processed it could be either moved to a sub folder called Processed Files within that month's folder, and at the end of the month we can return them back, or renamed by appending it with a special tag say "PrOCed" if that string will never ever appear in the file name, and then we can exclude any files in that new folder or with that tag.
I would suggest that you would simply read all the file names into a worksheet and then use Text-to-Columns to get the date and time of the file creation, plus maybe you can use the FileSystemObject to get that info to, and then simply use the Excel Group feature to get the breakdown by day and hour.
Hope this helps, if you need any code example, let me know.
Here's how I would do it. The following is largely untested
and should really be treated as pseudocode. Besides it's not
clear that I could give a definitive answer as I've had to make too
many assumptions (ie is Num in the directory just 'Num' or is
it a number, how is TIMESTAMP defined, etc).
I'm assuming that your pdfs will be properly filed in the
correct month folder.
Ie, for example, you won't have
say a month '09' in a '10' folder (this would be an error condition). If that's the case then
what I'm proposing should work. Note that I'm also assuming that
the filenames are correct. If not you can add additional error
processing. Right now if I find an error in the filename I simply skip it - but
you'll probably want to have it printed out as mentioned in the
code comments.
The main data structure is a dictionary that should end up having
a day entry (ie key,value) for each day of the month once all the pdfs for that
month have been processed. The key of this dictionary is a 2 digit
string that represents the day from '01' up to '31' (for the months that
have 31 days). The value is a 1 dimensional array of length 3. So a typical
entry could be (20,31,10) which is 20 files for period 1, 31 for period 2 and
10 for period 3.
For each file you process a regular expression that extracts the day and hour only.
I'm assuming that the period hours don't overlap (just makes things easier - ie so
I don't have to bother with minutes). Once that's extracted I then add to
that days array for the correct time period based on the hour I've found.
You should note that I assume if you've gone through all product directories
for a given month you have now all that months files. So with all the month
files you can now print out the period counts on a different worksheet for each
day.
I haven't bothered implementing 'SummarizeFilesForMonth' but this should be
relatively straightforward once everything else has been debugged. This is
the place where you'll iterate through the day keys in the proper order to
print out the period stats. Other than that there shouldn't have to be any
other additional sorting.
Option Explicit
' Gets all files with the required file extension,
' strips off both the path and the extension and
' returns all files as a collection (which might not be
' what you want - ie might want the full path on the 1st sheet)
Function GetFilesWithExt(path As String, fileExt As String) As Collection
Dim coll As New Collection
Dim file As Variant
file = dir(path)
Dim fileStem As String, ext As String
Do While (file <> "")
ext = Right(file, Len(file) - InStrRev(file, "."))
If ext = fileExt Then
fileStem = Right(file, Len(file) - InStrRev(file, "\"))
coll.Add Left(fileStem, Len(file) - 5)
End If
file = dir
Loop
Set GetFilesWithExt = coll
End Function
' Checks whether a directory exists or not
Function pathExists(path As String)
If Len(dir(path, vbDirectory)) = 0 Then
pathExists = False
Else
pathExists = True
End If
End Function
' TEST_DDMMYYYY_TIMESTAMP is the filename being processed
' assuming TIMESTAMP is hr min sec all concatenated with
' no intervening spaces and all are always 2 digits
Sub UpdateDictWithDayFile(ByRef dictForMonth As Variant, file As String)
Dim regEx As New RegExp
' only extracts day and hour - you'll almost certainly
' have to adjust this regular expression to suit your needs
Dim mat As Object
Dim Day As String
Dim Hour As Integer
regEx.Pattern = "TEST_(\d{2})\d{2}\d{4}_(\d{2})\d{2}\d{2}$"
Set mat = regEx.Execute(file)
If mat.Count = 1 Then
Day = mat(0).SubMatches(0) ' day is a string
Hour = CInt(mat(0).SubMatches(1)) ' hour is an integer
Else
' Think about reporting an error here using debug.print
' i.e., the filename isn't in the proper format
' and will not be counted
Exit Sub
End If
If Not dictForMonth.exists(Day) Then
' 1 dimensional array of 3 items; one for each time period
dictForMonth(Day) = Array(0, 0, 0)
End If
Dim periods() As Variant
periods = dictForMonth(Day)
' I'm using unoverlapping hours unlike what's given in your question
Select Case Day
Case Hour <= 6
periods(0) = periods(0) + 1
Case Hour >= 7 And Hour < 10
periods(1) = periods(1) + 1
Case Hour >= 10
periods(2) = periods(2) + 1
Case Else
' Another possible error; report on debug.print
' will not be counted
Exit Sub
End Select
End Sub
Sub SummarizeFilesForMonth(ByRef dictForMonth As Variant)
' This is where you write out the counts
' to the new sheet for the month. Iterate through each
' day of the month in 'dictForMonth' and print
' out each of pdf counts for the individual periods
' stored in the 1 dimensional array of length 3
End Sub
Sub ProcessAllFiles()
' For each day of the month for which there are pdfs
' this dictionary will hold a 1 dimensional array of size 3
' for each
Dim dictForMonth As Object
Dim year As Integer, startYear As Integer, endYear As Integer
Dim month As Integer, startMonth As Integer, endMonth As Integer
Dim prodNum As Integer, startProdNum As Integer, endProdNum As Integer
Dim file As Variant
Dim files As Collection
startYear = 2014
startMonth = 1
endYear = 2017
endMonth = 2
startProdNum = 1
endProdNum = 3
Dim pathstem As String, path As String
pathstem = "D:\Tests\Manufact\Prod_"
Dim ws As Worksheet
Dim row As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
row = 1
For year = startYear To endYear:
For month = 1 To 12:
Set dictForMonth = CreateObject("Scripting.Dictionary")
For prodNum = startProdNum To endProdNum
If prodNum = endProdNum And year = endYear And month > endMonth Then Exit Sub
path = pathstem & prodNum & "\Machine\Num\" & year & "\" & Format(month, "00") & "\"
If pathExists(path) Then
Set files = GetFilesWithExt(path, "pdf")
For Each file In files:
' Print out file to column 'A' of 'Sheet1'
ws.Cells(row, 1).Value = file
row = row + 1
UpdateDictWithDayFile dictForMonth, CStr(file)
Next
End If
Next prodNum
SummarizeFilesForMonth dictForMonth
Next month
Next year
End Sub
OK Thanks for confirming the limitations Jan
So then the next option is to build a list of file names in a worksheet that have been processed and pass them, for example if you are using a For Each loop to loop through the files, there will be a test to see if the current name of the file is in the list of processed files, skip it otherwise process it and add its name to the list.
3 refers to all the files in a past month. This way we can search for files by date and get new files to process. So all files generated past a certain date (last run date) will be considered new and need to be processed.
Will that work?
I have a folder with lots of text files each containing (but in random order) :
A = ...
B = ...
C = ...
Now I would like to import these text files into an excel-spreadsheet,
where each of the prefixes is organized in the colums, and the files are listed as rows
Example: 2 files
File 1:
A = 1
B = 2
C = 3
File 2:
A = 4
B = 5
C = 6
I would the excel to look like :
NR / A / B / C
1 / 1 /2 /3
2 / 4/ 5 /6
I am still learning VB, and this is just a bit over the top for me.
I have found a macro like this:
Sub Read_Text_Files()
Dim sPath As String, sLine As String
Dim oPath As Object, oFile As Object, oFSO As Object
Dim r As Long
'Files location
sPath = "C:\Test\"
r = 1
Set oFSO = CreateObject( _
"Scripting.FileSystemObject")
Set oPath = oFSO.GetFolder(sPath)
Application.ScreenUpdating = False
For Each oFile In oPath.Files
If LCase(Right(oFile.Name, 4)) = ".txt" Then
Open oFile For Input As #1 ' Open file for input.
Do While Not EOF(1) ' Loop until end of file.
Input #1, sLine ' Read data
If Left(sLine, 1) = "A=" Then 'Now i need to write this to the first column of that row
If Left(sLine, 1) = "B=" Then 'For the second column.
Range("A" & r).Formula = sLine ' Write data line
r = r + 1
Loop
Close #1 ' Close file.
End If
Next oFile
Application.ScreenUpdating = True
End Sub
Do you know how to open files in VBA for reading using syntax like Open and Line Input?
If not, read this: https://stackoverflow.com/a/11528932/2832561
I found this by googling for "VBA open file read"
Do you know how to work with and parse strings (and arrays) using functions like Mid, Left, Right, Split and Join?
If not, try reading this: http://www.exceltrick.com/formulas_macros/vba-split-function/
I found this by googling for "VBA String functions parse text"
Do you know how to work with Workbook and Worksheet objects and assign values to Range objects in Excel?
If not, try reading this: http://www.anthony-vba.kefra.com/vba/vbabasic2.htm
I found this by googling for "Workbook Worksheet Range VBA"
Once you have had a chance to try putting together a solution using these pieces, you can post specific questions on any issues you run into.
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.